Hej, Har en stor lista med personuppgifter som jag skulle vilja ha hjälp med att strukturera upp med hjälp av Excel (2003). Som det ser ut just nu så har varje person 3 rader: 5. Exempel Exempelsson Exempelvägen 1 A, 111 11 Exempelstaden Fyller 20 år om 72 dagar, född den 1 januari 1993 6. Exempel2 Exempel2sson Exempelvägen 2 A, 111 11 Exempelstaden Fyller 20 år om 73 dagar, född den 2 januari 1993 Och så vidare med väldigt många personer. Jag skulle vilja ha lite tips på hur excel kan göra det mesta av städjobbet åt mig. Målet är att få all information i 5 olika kolumner enligt nedan: 19930101 - Exempel Exempelsson - Exempelvägen 1 A - 111 11 - Exempelstaden Alltså: 1. Siffran framför namnet måste bort, den är irrelevant 2. All information om födelsedag mm ska omformateras till första 6 siffror i personnumret 3. Personnummer, Namn, Adress, Postnummer, Stad ska alla ligga i varsin kolumn Är det någon som vet om detta är möjligt och kan hjälpa mig iaf med någon av utmaningarna?

Du behöver ett makro för att få posternas olika "fält" uppdelade på kolumner istället för rader. Du kan använda mitt exempel nedan. Det fungerar med de exempel du listat oven (förutsatt att de ligger i kolumn A).

När du väl har posterna uppdelade på kolumner kan du använda en formel för ta ut delar av texten. Formelexemplet nedan letar efter textstycket ", " i cell B1 och hämter all text därefter.
=EXTEXT(B1;HITTA(", ";B1)+2;LÄNGD(B1))

Texten nedan kopierar du och lägger in i en modul (öppna VBA editorn (alt+F11), högerklicka på VBAprojekt och välj infoga modul). Sen kör du makrot (alt+F8) i den arbetsbok där du har värdena

Public Sub Group_Info()
Dim strArrPerInfo() As String
Dim lngInc1 As Long
ReDim strArrPerInfo(2, 0)
strArrPerInfo(0, 0) = "Unallocated"

Do Until lngInc1 > 65535
If IsNumeric(Mid(ActiveWorkbook.ActiveSheet.Cells(lngInc1 + 1, 1).Value, 1, 1)) = True Then
If strArrPerInfo(0, 0) <> "Unallocated" Then
ReDim Preserve strArrPerInfo(2, UBound(strArrPerInfo, 2) + 1)
End If
strArrPerInfo(0, UBound(strArrPerInfo, 2)) = ActiveWorkbook.ActiveSheet.Cells(lngInc1 + 1, 1).Value
ElseIf InStr(1, ActiveWorkbook.ActiveSheet.Cells(lngInc1 + 1, 1).Value, "född den") > 0 Then
strArrPerInfo(2, UBound(strArrPerInfo, 2)) = ActiveWorkbook.ActiveSheet.Cells(lngInc1 + 1, 1).Value
ElseIf ActiveWorkbook.ActiveSheet.Cells(lngInc1 + 1, 1).Value <> "" Then
strArrPerInfo(1, UBound(strArrPerInfo, 2)) = ActiveWorkbook.ActiveSheet.Cells(lngInc1 + 1, 1).Value
End If
lngInc1 = lngInc1 + 1
Loop

Workbooks.Add lngInc1 = 0
Do Until lngInc1 > UBound(strArrPerInfo, 2)
ActiveWorkbook.ActiveSheet.Cells(lngInc1 + 1, 1).FormulaR1C1 = strArrPerInfo(0, lngInc1)
ActiveWorkbook.ActiveSheet.Cells(lngInc1 + 1, 2).FormulaR1C1 = strArrPerInfo(1, lngInc1)
ActiveWorkbook.ActiveSheet.Cells(lngInc1 + 1, 3).FormulaR1C1 = strArrPerInfo(2, lngInc1)
lngInc1 = lngInc1 + 1
Loop
Columns.AutoFit

End Sub