VBA vergleich 2 Excel Frage

  • Excel

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

    VBA vergleich 2 Excel Frage

    Hallo,

    ich bin neu hier und mein erster Beitrag fangt mit Frage :D .
    Ich bin auch neu bei VBA Excel Programmierung.


    Ich muss 2 Excel vergleichen " Zeile : Name: nicht geändert, Neu oder Gelöscht ; Spalte : wenn in der Zeile nicht geändert wurde dann Spalte vergleichen ob was geändert wurde " und Diff speichern und markieren . soweit habe ich kein Problem.
    Mein Problem ist
    im Excel sind gleiche Name ca 6 vorhanden und manchmal kann vorkommen dass die Name gelöscht ist , oder im Excel 2 neu dazu gekommen
    Bp.
    Excel 1
    Muller 1985 180cm Blond ....... A1
    Muller 1600€ 30T unbef ..... A2
    Muller ......... A3
    Muller ........ A4

    Excel 2
    Muller 1985 180cm Blond ....... A1
    Muller 1800€ 30T unbef ..... A2
    Muller ......... A3
    Muller ........ A4

    Excel 1
    Ralf ...........A25-A30
    Marc ..........A31-A35
    Exce2
    Marc .........A25-A30

    Soll
    Muller A2 im B2 wurde geändert
    Ralf ist gelöscht
    dann soll Marc "Excel1" A31-35 mit Marc "Excel2" A25-A30 vergleichen



    Es geht wenn nur einmal Muller vorhanden ist

    Für eure Vorschläge bin ich bedankbar

    Visual Basic-Quellcode

    1. Sub DiffTM()
    2. Dim l(200) As Boolean
    3. Dim idiff As Boolean
    6. Zeile_Old = Workbooks(sFILETM2).Sheets(1).UsedRange.Rows.Count
    7. Spalte_Old = Workbooks(sFILETM2).Sheets(1).UsedRange.Columns.Count
    8. Zeile_New = Workbooks(sFILETM).Sheets(1).UsedRange.Rows.Count
    9. Spalte_New = Workbooks(sFILETM).Sheets(1).UsedRange.Columns.Count
    11. Tabell1 = Workbooks(sFILETM2).Sheets(1).Name
    12. Tabell1 = Workbooks(sFILETM).Sheets(1).Name
    13. 'Tabell2 = Workbooks(sFILETM2).Sheets(2).Name
    14. 'Tabell2 = Workbooks(sFILETM).Sheets(2).Name
    18. If Sheets("CTRL").OptionButtonIN.Value = "Wahr" Then
    19. sSection = Tabell1
    20. Sheets("DIFF_1").Activate
    21. Else
    23. sSection = Tabell2
    24. Sheets("DIFF_2").Activate
    26. End If
    28. ActiveSheet.Range("A5:O65536").Select
    29. Selection.Interior.ColorIndex = 0
    30. Selection = ""
    31. ActiveSheet.Range("A1:A1").Select
    34. ZMAX = Workbooks(sFILETM).Sheets(sSection).UsedRange.Rows.Count
    35. SMAX = Workbooks(sFILETM).Sheets(sSection).UsedRange.Columns.Count
    37. Z2MAX = Workbooks(sFILETM2).Sheets(sSection).UsedRange.Rows.Count
    38. Spalte = Workbooks(sFILETM2).Sheets(sSection).UsedRange.Columns.Count
    41. IMAX = Z2MAX
    42. JMAX = ZMAX
    43. PMAX = JMAX * 2
    47. K = 5
    48. For I = 2 To IMAX
    49. For J = 2 To JMAX
    51. If Workbooks(sFILETM2).Sheets(sSection).Cells(I, 1) = Workbooks(sFILETM).Sheets(sSection).Cells(J, 1) Then
    52. idiff = False
    53. For a = 1 To Spalte
    54. l(a) = (Workbooks(sFILETM).Sheets(sSection).Cells(J, a) <> Workbooks(sFILETM2).Sheets(sSection).Cells(I, a))
    55. If l(a) Then idiff = True
    57. Next a
    59. If idiff = True Then
    60. For M = 1 To a
    61. Cells(K, M) = Workbooks(sFILETM2).Sheets(sSection).Cells(I, M)
    62. If l(M) Then
    63. Cells(K, M) = Workbooks(sFILETM2).Sheets(sSection).Cells(I, M)
    64. Call DoBlue(K, M)
    65. End If
    66. Next M
    67. K = K + 1
    68. End If
    69. Exit For
    70. Else
    72. If J = JMAX Then
    73. For M = 1 To a
    74. Cells(K, M) = Workbooks(sFILETM2).Sheets(sSection).Cells(I, M)
    75. Call DoGreen(K, M)
    76. Next M
    77. K = K + 1
    78. End If
    79. End If
    80. Next J
    83. Next I
    87. For I = 2 To IMAX
    88. For J = 2 To JMAX
    89. If Workbooks(sFILETM2).Sheets(sSection).Cells(J, 1) = Workbooks(sFILETM).Sheets(sSection).Cells(I, 1) Then
    90. Exit For
    91. Else
    92. If J = JMAX Then
    93. For M = 1 To a
    94. Cells(K, M) = Workbooks(sFILETM).Sheets(sSection).Cells(I, M)
    96. Call DoRed(K, M)
    97. Next M
    98. K = K + 1
    99. End If
    100. End If
    101. Next J
    103. Next I
    106. Workbooks(sFILETM).Close
    107. Workbooks(sFILETM2).Close
    108. End Sub


    *Topic verschoben*

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Marcus Gräfe“ ()

Facebook
Telefonspende