Fehler in Schleife zum Abgleichen & Aufadieren

  • Excel

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von petaod.

    Fehler in Schleife zum Abgleichen & Aufadieren

    Hallo,

    ich habe ein Makro geschrieben, das diese zweite Tabelle öffnet und diese durchläuft und dabei zählt, wie oft der Wert in der 3.Spalte vorkommt:
    Name 1
    ...
    AT
    Name 2
    ...
    AT
    Name 3
    ...
    AT


    191
    Name 4
    ...
    BE
    Name 5
    ...
    BE

    in der Liste ist bereits eine Zeile vorhanden, die die Anzahl enthält, wie hier die 191. Allerdings halte ich es für unkomplizierter, wenn ich erneut zählen lasse, denn dann kann ich die Zahlen leichter den Werten zuordnen.


    Diese Anzahl soll in diese benannte Range (hier mit dem Namen "UserAff") geschrieben werden:

    Jan
    Feb
    Mär...
    AT


    191
    BE


    46
    BR


    201
    CH


    17584
    DK


    6

    Das klappt so weit auch wunderbar. Probleme bekomme ich nur bei dem CH, da es in der Range nicht in der gleichen Reihenfolge wie in der zweiten Liste, in der ich zähle auftaucht. Durch einen Fehler, den ich seit 2 Tagen erfolglos suche in
    meinem Code, addiert er dann nämlich zu dem CH noch die Anzahl eines anderen Wertes, der nicht in diese Range soll. Das habe ich eigentlich versucht ab Zeile 37 abzufangen, aber es hilft nichts. Wenn ich das "A = 0" in Zeile 38 nicht auskommentiert habe, bekomme ich in der Zielrange nur noch 1er angezeigt ab der zweiten Zeile.
    Ich habe jetzt verschiedenste Varianten probiert, aber ich komme leider nicht mehr weiter.

    Vielen Dank im Vorruas für eure Hilfe

    Mit freundlichen Grüßen
    MultiTobi96



    Quellcode

    1. Sub SLA_füllen()
    2. Dim fd As FileDialog
    3. Dim user As String
    4. Dim oSourceSheet As Object
    5. Dim oWorkbookSource As Object
    6. Dim oTargetSheet As Object
    7. Dim monat As String
    8. monat = ActiveSheet.Cells(3, 16)
    9. Set oTargetSheet = ActiveWorkbook.Sheets(1)
    10. Set fd = Application.FileDialog(msoFileDialogFilePicker)
    11. fd.AllowMultiSelect = False
    12. If fd.Show = -1 Then
    13. For Each vrtSelectedItem In fd.SelectedItems
    14. Set oWorkbookSource = Workbooks.Open(vrtSelectedItem, True)
    15. Set oSourceSheet = oWorkbookSource.Sheets(1)
    16. Next vrtSelectedItem
    17. Else
    18. 'Abbruchbedingung
    19. MsgBox ("Bitte gesamte Userliste angeben. Programm wird beendet")
    20. Exit Sub
    21. End If
    22. For k = 2 To oSourceSheet.UsedRange.Rows.Count
    23. If oSourceSheet.Cells(k, 3).Value = oSourceSheet.Cells(k + 1, 3).Value Then
    24. A = A + 1
    25. Else
    26. 'Übertragen der Anzahl in die Zieltabelle
    27. For i = 1 To oTargetSheet.Range("UserAff").Rows.Count
    28. If oSourceSheet.Cells(k, 3).Value = oTargetSheet.Range("UserAff").Cells(i, 1).Value Then
    29. oTargetSheet.Range("UserAff").Cells(i, 8).Value = A + 1
    30. A = 0
    31. k = k + 1
    32. Else
    33. 'A = 0
    34. k = k + 1
    35. End If
    36. Next i
    37. End If
    38. Next k
    39. oWorkbookSource.Close
    40. End Sub