Avatar billede brianlindhardt Praktikant
28. september 2009 - 14:44 Der er 8 kommentarer og
1 løsning

Opsumere data fra 2 faner

Hejsa

Jeg har en fil med 3 faner (Excel 2007).

På fane 1 står der i kolonne A nogle kundenumre - efterfulgt af data i kolonnerne B - E. Her er der ca. 9800 rækker.

På fane 2 står der i kolonne A nogle debitornumre - efterfulgt af data i kolonnerne B - H. Her er der ca. 13000 rækker.

Min plan er så en metode eller makro, der kan samle alle disse data på fane 3.
Nogle kundenumre figurer kun på fane 1 og nogle debitornumre figurerer kun på fane 2.
Nogle af kundenumrene fra fane 1 er identisk med nogle af debitornumrene fra fane 2. Men de efterfølgende data er forskellige, og skulle gerne samles i én række på fane 3.

Til slut skal alle kunder/debitorer figurere på fane 3 og kun 1 gang og med alle data samlet i kolonnerne B - L, selvom der naturligvis vil være tomme celler fra de emner, som kun optræder på den ene af de 2 faner.
Avatar billede tjacob Juniormester
28. september 2009 - 17:59 #1
Det kan laves i en makro. Lige et par opklarende spørgsmål:

I hvilken række starter data? (er der overskrifter?)
Er der huller? -tomme rækker?
Står kunde/debitornumre i nogen orden i ark 1 og 2?
Skal de stå i orden i ark 3? (skal ark1 og 2 'flettes'?)
Avatar billede brianlindhardt Praktikant
29. september 2009 - 08:05 #2
For både fane 1 og fane 2 gælder, at data starter i række 2, da der på begge faner er en overskrift. Derfor må de ligeledes gerne starte i række 2 på fane 3, da en overskrift nok er nødvendig.

Der er ingen tomme rækker, men der er dog enkelte celler, der ikke indeholder data - eks. har alle kunder/debitorer ikke fax.

Der er ingen orden på fanerne - kunder/debitorer er blevet tilføjet løbende.

Hvis det kan lade sig gøre, kunne det være lækkert, hvis der kunne laves følgende rækkefølge på fane 3: først alle emner, som kun er på fane 1 - dernæst alle emner, som kun er på fane 2 - sidst de emner, der er på begge faner.
Avatar billede tjacob Juniormester
29. september 2009 - 11:01 #3
OK, her er et bud:
Forudsætning: Ark3 skal eksistere i forvejen og være tomt.

Da jeg kun har testet på små mængder data, ved jeg ikke rigtigt hvor hurtigt det går; det kan godt tage et stykke tid.......


Sub LavNytArk3()

    Application.ScreenUpdating = False
    Dim i As Long, j As Long, k As Long
    Sheets(1).Select
    i = Range("a2").End(xlDown).Row
    Dim KundeNr1() As Long
    ReDim KundeNr1(2 To i)
    Sheets(2).Select
    i = Range("a2").End(xlDown).Row
    Dim KundeNr2() As Long
    ReDim KundeNr2(2 To i)
    Dim RowNr1x() As Long
    Dim RowNr2x() As Long
    For i = 2 To UBound(KundeNr2)
            KundeNr2(i) = Cells(i, 1)
    Next i
    Sheets(1).Select
    For i = 2 To UBound(KundeNr1)
            KundeNr1(i) = Cells(i, 1)
    Next i
    For i = 2 To UBound(KundeNr1)
        For j = 2 To UBound(KundeNr2)
            If KundeNr1(i) = KundeNr2(j) Then
                ReDim Preserve RowNr1x(k)
                ReDim Preserve RowNr2x(k)
                RowNr1x(k) = i
                RowNr2x(k) = j
                KundeNr1(i) = 0
                KundeNr2(j) = 0
                k = k + 1
            End If
        Next j
    Next i
    k = 2
    For i = 2 To UBound(KundeNr1)
        Sheets(1).Select
        If Not KundeNr1(i) = 0 Then
            Range(Cells(i, 1), Cells(i, 5)).Select
            Selection.Copy
            Sheets(3).Select
            Range(Cells(k, 1), Cells(k, 5)).Select
            ActiveSheet.Paste
            k = k + 1
        End If
    Next i
    For i = 2 To UBound(KundeNr2)
        Sheets(2).Select
        If Not KundeNr2(i) = 0 Then
            Range(Cells(i, 2), Cells(i, 8)).Select
            Selection.Copy
            Sheets(3).Select
            Cells(k, 1) = KundeNr2(i)
            Range(Cells(k, 6), Cells(k, 12)).Select
            ActiveSheet.Paste
            k = k + 1
        End If
    Next i
    For i = 0 To UBound(RowNr1x)
        Sheets(1).Select
        Range(Cells(RowNr1x(i), 1), Cells(RowNr1x(i), 5)).Select
        Selection.Copy
        Sheets(3).Select
        Range(Cells(k, 1), Cells(k, 5)).Select
        ActiveSheet.Paste
        Sheets(2).Select
        Range(Cells(RowNr2x(i), 2), Cells(RowNr2x(i), 8)).Select
        Selection.Copy
        Sheets(3).Select
        Range(Cells(k, 6), Cells(k, 12)).Select
        ActiveSheet.Paste
        k = k + 1
    Next i
    Application.ScreenUpdating = True
   
End Sub


Det kan godt være der skal nogle små tilretninger til, så tager vi den derfra..........
Avatar billede tjacob Juniormester
29. september 2009 - 11:57 #4
Der kan spares lidt tid i dobbeltloopet, ved at indsætte en ekstra linie (Exit For):


For i = 2 To UBound(KundeNr1)
        For j = 2 To UBound(KundeNr2)
            If KundeNr1(i) = KundeNr2(j) Then
                ReDim Preserve RowNr1x(k)
                ReDim Preserve RowNr2x(k)
                RowNr1x(k) = i
                RowNr2x(k) = j
                KundeNr1(i) = 0
                KundeNr2(j) = 0
                k = k + 1
                Exit For
            End If
        Next j
    Next i
Avatar billede brianlindhardt Praktikant
30. september 2009 - 08:14 #5
Når jeg prøver at eksekvere makroen får jeg en runtime error, hvor debuggeren står på "KundeNr2(i) = Cells(i, 1)" - fejlmeddelelsen er en overflow.

Der er for øvrigt netop blevet tilføjet flere data, således at fane 1 nu indeholder data i kolonnerne B - F. Kundenummeret (som er et tal på op til 11 cifre) er stadig placeret i kolonne A.

På fane 2 er der ligeledes tilføjet data, således at der nu er data i kolonnerne B - N. Debitornummeret er ligeledes et tal på op til 11 cifre.
Avatar billede tjacob Juniormester
30. september 2009 - 09:00 #6
OK, fejmeddelelsen kommer pga det 11-cifrede tal, -det er større end en Long Datatype, og derfor kommer der overflow.
Jeg retter den lige til......
Avatar billede tjacob Juniormester
30. september 2009 - 09:14 #7
Prøv igen:


Sub LavNytArk3()

    Application.ScreenUpdating = False
    Dim i As Long, j As Long, k As Long
    Sheets(1).Select
    i = Range("a2").End(xlDown).Row
    Dim KundeNr1() As Variant
    ReDim KundeNr1(2 To i)
    Sheets(2).Select
    i = Range("a2").End(xlDown).Row
    Dim KundeNr2() As Variant
    ReDim KundeNr2(2 To i)
    Dim RowNr1x() As Long
    Dim RowNr2x() As Long
    For i = 2 To UBound(KundeNr2)
            KundeNr2(i) = Cells(i, 1)
    Next i
    Sheets(1).Select
    For i = 2 To UBound(KundeNr1)
            KundeNr1(i) = Cells(i, 1)
    Next i
    For i = 2 To UBound(KundeNr1)
        For j = 2 To UBound(KundeNr2)
            If KundeNr1(i) = KundeNr2(j) Then
                ReDim Preserve RowNr1x(k)
                ReDim Preserve RowNr2x(k)
                RowNr1x(k) = i
                RowNr2x(k) = j
                KundeNr1(i) = 0
                KundeNr2(j) = 0
                k = k + 1
                Exit For
            End If
        Next j
    Next i
    k = 2
    For i = 2 To UBound(KundeNr1)
        Sheets(1).Select
        If Not KundeNr1(i) = 0 Then
            Range(Cells(i, 1), Cells(i, 6)).Select
            Selection.Copy
            Sheets(3).Select
            Range(Cells(k, 1), Cells(k, 6)).Select
            ActiveSheet.Paste
            k = k + 1
        End If
    Next i
    For i = 2 To UBound(KundeNr2)
        Sheets(2).Select
        If Not KundeNr2(i) = 0 Then
            Range(Cells(i, 2), Cells(i, 14)).Select
            Selection.Copy
            Sheets(3).Select
            Cells(k, 1) = KundeNr2(i)
            Range(Cells(k, 7), Cells(k, 19)).Select
            ActiveSheet.Paste
            k = k + 1
        End If
    Next i
    For i = 0 To UBound(RowNr1x)
        Sheets(1).Select
        Range(Cells(RowNr1x(i), 1), Cells(RowNr1x(i), 6)).Select
        Selection.Copy
        Sheets(3).Select
        Range(Cells(k, 1), Cells(k, 6)).Select
        ActiveSheet.Paste
        Sheets(2).Select
        Range(Cells(RowNr2x(i), 2), Cells(RowNr2x(i), 14)).Select
        Selection.Copy
        Sheets(3).Select
        Range(Cells(k, 7), Cells(k, 19)).Select
        ActiveSheet.Paste
        k = k + 1
    Next i
    Application.ScreenUpdating = True
   
End Sub
Avatar billede brianlindhardt Praktikant
30. september 2009 - 10:20 #8
Super - ser umiddelbart ud til at virke efter hensigten. De enkelte kunder, som jeg lige har tjekket er i hvert fald repræsenteret på ark 3 med alle data - og er kun repræsenteret 1 gang.

Tusind tak for hjælpen - og smider du lige et svar, så du kan få dine velfortjente points.
Avatar billede tjacob Juniormester
30. september 2009 - 11:04 #9
OK, -svar
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester