Arrangere "rå" data?

Sub Makro1()
    Dim Data As Variant
    Data = Range("A1:B" & Range("A65536").End(xlUp).Row)
    x = 0
    For I = 2 To UBound(Data)
   
        If Data(I, 1) = Data(I - 1, 1) Then
If x = 0 Then x = I - 1
            Data(x, 2) = Data(x, 2) & vbLf & Data(I, 2)
            Data(I, 2) = Empty
        Else
        x = 0
        End If
    Next
      Range("A1:B" & Range("A65536").End(xlUp).Row) = Data
      Range("B1:B" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

prøv at teste, den gemmer oveni orginal data, så tag kopi

Det virker her i version 2007, men den burde vel også virke i de ældre versioner? Opret et svar så du kan få points :)

Hvad hvis der kommer en infomation der går igen for hver "stam" værdi. Dvs.:

A1:x B1:1
A2:x B2:1
A3:y B3:2
A4:z B4:3
A5:z B5:3
A6:z B5:3

C1:a
C2:b
C3:c
C4:d
C5:e
C6:f

Og det skal se således ud:

A1:x
B2:1
C2:a[ny linje]b

A2:y
B2:2
C2:c

A3:z
B3:3
C3:d[ny linje]e[ny linje]f

Iøvrigt, kan I anbefale nogle gode sider/bøger hvis man vil lærer sådanne ting om makroer mv.?

Jeg forstår ikke lige hvad du mener med det sidste, du spørger om.
Er er ikke altid 2 kolonner A og B i rådata ??

I den anden post vil det være tilfælde hvis der er tre kolonner med rå data, hvor det er kolonne a der stadig skal bestemme.

Er der et bestemt "element" man ændre for at tilføje en kolonne?

På forhånd mange tak for hjælpen..

Ok
Jeg læser nu Kolonne A til E.

Du skal klikke ind på en celle i den kolonne der skal deles op, i dit eksempel C.
Den kan bruges i begge tilfælde nu, bare du klikker ind på en celle i den valgte kolonne.
Den tjekker kun kolonne A for dubletter

kør derefter makroen.

Sub Makro1()
    Dim Data As Variant
    Data = Range("A1:E" & Range("A65536").End(xlUp).Row)
    x = 0
    y = ActiveCell.Column
    For I = 2 To UBound(Data)
 
        If Data(I, 1) = Data(I - 1, 1) Then
If x = 0 Then x = I - 1
            Data(x, y) = Data(x, y) & vbLf & Data(I, y)
            Data(I, y) = Empty
        Else
        x = 0
        End If
    Next
      Range("A1:E" & Range("A65536").End(xlUp).Row) = Data
      Range(Cells(1, y), Cells(Range("A65536").End(xlUp).Row, y)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Øv... Troede jeg havde så meget styr på det så jeg selv kunne rette det lidt til.. Men nej..

Hvad er det for nogle linjer man skal rette i for at lade makroen søge efter dubletter i kolonne B?

Og hvordan tilføjer man kolonner? Eks. fra A til H.. Troede det bare var at udskifte E med H, men det virker ikke..

Sub Makro1()
    Dim Data As Variant
    Data = Range("A1:H" & Range("A65536").End(xlUp).Row)
    x = 0
    y = ActiveCell.Column
    For I = 2 To UBound(Data)

        If Data(I, 1) = Data(I - 1, 1) Then
If x = 0 Then x = I - 1
            Data(x, y) = Data(x, y) & vbLf & Data(I, y)
            Data(I, y) = Empty
        Else
        x = 0
        End If
    Next
      Range("A1:H" & Range("A65536").End(xlUp).Row) = Data
      Range(Cells(1, y), Cells(Range("A65536").End(xlUp).Row, y)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

det er denne linje der bestemmer kolonnen med dubletter

If Data(I, 1) = Data(I - 1, 1) Then' et tallet efter kommaet betyder kolonne 1 altså A kolonnen.

If Data(I, 2) = Data(I - 1, 2) Then ' to tallet efter kommaet betyder kolonne 2 altså B kolonnen.

Læg mærke til "Range("A65536").End(xlUp).Row"
i
Data = Range("A1:H" & Range("A65536").End(xlUp).Row)
og
  Range("A1:H" & Range("A65536").End(xlUp).Row) = Data

Det betyder at der altid skal være data i A kolonnen, hvis ikke skal du vælge en kolonne der er data i.
eks.

Range("B65536").End(xlUp).Row

Så har jeg fået adgang til "rå" dataen, og ikke kun den lille udsnit jeg har lavet tests på. Den går op til 63620 rækker...

Desværre får jeg følgende fejlmeddelelse:

Run-time error '1004': Application-defined or object-defined error.

Også er denne linje markeret med gult:

Range("A1:I" & Range("B65536").End(xlUp).Row) = Data

Koden ser således ud:

Sub Makro2()
    Dim Data As Variant
    Data = Range("A1:I" & Range("B65536").End(xlUp).Row)
    x = 0
    y = ActiveCell.Column
    For I = 2 To UBound(Data)

        If Data(I, 2) = Data(I - 1, 2) Then
If x = 0 Then x = I - 1
            Data(x, y) = Data(x, y) & vbLf & Data(I, y)
            Data(I, y) = Empty
        Else
        x = 0
        End If
    Next
      Range("A1:I" & Range("B65536").End(xlUp).Row) = Data
      Range(Cells(1, y), Cells(Range("B65536").End(xlUp).Row, y)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Når jeg kigger ned på arket kan jeg se den er kommet til linje 602, så skulle men tro det var lige den linje der var problemer med..

Men efter at sætte mindre stykker ind mv. kan jeg se at det bestemt ikke er samme sted den laver fejl (det variere efter antal rækker, men hvis jeg kører makroen på det samme ark uden at slette er det samme sted den stopper)

Kan det være noget hukommelse der er fyldt op e.l.?

Prøv denne

Sub Makro2()
    Dim Data As Variant,RW as long
    RW =  Range("B65536").End(xlUp).Row
    Data = Range("A1:I" & RW)
    x = 0
    y = ActiveCell.Column
    For I = 2 To UBound(Data)

        If Data(I, 2) = Data(I - 1, 2) Then
If x = 0 Then x = I - 1
            Data(x, y) = Data(x, y) & vbLf & Data(I, y)
            Data(I, y) = Empty
        Else
        x = 0
        End If
    Next
      Range("A1:I" & RW) = Data
      Range(Cells(1, y), Cells(RW, y)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Den kommer desværre med samme fejlmeddelse :/

Det som Excel-arket indeholder er data fra nogle tekniske tegninger..

Jeg har prøvet nogle forskellige ting:

1. Prøve kun at tage det stykke hvor jeg ved der er problemer og kører makroen på det, samme fejlmeddelse kommer igen. Derefter - stadig i det lille udsnit af dokumentet - at skrive 1 2 3 osv. i celle F. Når det er gjort vil den godt køre makroen, i det lille dokument..

2. Prøv at ændre hele data-kolonnen i F til 1 2 3 osv. hele vejen ned til og med række 63620. Når jeg så kører makroen ender jeg bare med et tomt dokument..

3. Lave samme nummer på op til 42800 rækker - ingen problemer.. (altså med 1 2 3, den brokker sig stadig når det er tekst) Men når jeg kommer over dette antal, så er det den ender med et tomt dokument..

Jeg har også prøvet at tage nogle af de rækker jeg ved giver problemer (28 stk med samme dublet) Prøvede så at køre makroen et par gange lige efter hinanden:

1. gang: Den kom bare med run-time fejl.

2. gang: Den samlede de to første rækker, men så kom den med fejl.

3. gang: Ud over de to rækker der er samlet kommer den tredje række også der op, dog med et mellemrum mellem de to første.

Den bliver så ved med at samle en række, også komme med fejlmeddelse, indtil den har samlet 5 rækker, (11 rækker hvis man også regner dem med mellemrum med)

Når jeg så trykker igen samler den alle de resterende i én stor celle - som den skal - Men den samme dublet bruger stadig to rækker. En hvor der er mellemrum, og de resterende som er rigtige (hvor der dog mangler det data der gik til den første række..)
Når jeg så kører makroen første gang kommer den med run-time fejlen.. Når jeg så kører makroen igen

Nu har jeg prøvet at tage samme data-række som nævnt i kommentaren 14:44:02.

Jeg lavede en søg/erstat på alle rækkerne, hvor jeg fjernede alle mellemrum, alle komma-tegn, og i det hele taget alle tegn så det kun var tal og bokstaver.

Når jeg så kører makroen deler den rækkerne op i to store rækker, kører jeg makroen igen laver den det rigtigt - nemlig én stor række.

Ingen der har en løsning..?