Tabellenblätter vergleichen

  • Excel

Es gibt 16 Antworten in diesem Thema. Der letzte Beitrag () ist von VBA Begins.

    Tabellenblätter vergleichen

    Hallo Petaod,
    hab mich lange nicht mehr mit der Materie befasst und nun folgendes Problem (siehe Excel Anhang).
    Ziel ist: Tabellenblatt1(T1) mit Tabellenblatt2(T2) vergleichen.
    In T2 stehen alle Attribute DE1_I_LVERS#, VERTR#,DE1_I_ABR_TERM u.s.w. und in jeweils gleicher Spalte 1 drunter die Wertinhalte
    von links nach rechts und dann nach unten schön geordnet. (Also Zeilenweise) Farblich markiert mit Aquamarin
    Genau die gleichen Attribute stehen nun spaltenweise in T1. Das nicht so gute: Ausgabe für T1 stammt aus einer Datenbank, welche über Ultraedit in Excel gezogen wurde. Hier stehen jetzt in einer Zelle das Attribut und mit ; (Strichpunkt) getrennt und "" Hochkommata die Wertinhalte. (Aquamarin) Mehr noch: Vor dem Attribut; "Wertinhalt"; stehen noch 4 Einträge mit ;;; getrennt, die eigentlich aus der Zelle herauskönnten. Ob sie für einen Vergleich rausmüssen, weiß ich nicht? Ziel ist es jetzt also, Aquamarinen Wertinhalt und alle anderen Wertinhalte von T2 mit Aquamarin Wertinhalt aus T1 zu vergleichen. Wenn Wertinhalt nicht gleich ist, wäre es schön, wenn der abweichende Wert aus T2 mit seinem Attribut in T1 in Spalte B neben dem abweichenden Wert stehen würde und rot eingefärbt wird. Etwas tricky ist dann vielleicht noch das in T1 und T2 rot eingefärbte. Da stehen 2 Wertinhalte untereinander, die aber auch zeilenweise durchlaufen werden. In T1 wird das durch die Datenbankmitgabe VERSB(1,1), VERSB(1,2) deutlich.
    Der Vergleich beginnt ab Spalte F in T2. Die Spalten vorher werden als Schlüssel verwendet. Also ab Spalte F stimmen zeilenweise Attribute genau überein mit spaltenweise Attribute in T1. Petaod, kannst du mir da bitte helfen. Ich hab kein Plan mehr. In Tabelle 3 hab ich mal einen Code angefangen, den ich vor nem Jahr zu sowas geschrieben habe. Scheint mir aber viel zu umständlich.

    Danke und Viele Grüsse
    VBA Begins
    Dateien
    Bis ins Detail habe ich nicht verstanden, was du meinst.
    Ausserdem ist das Wetter da draussen viel zu schön. ;)

    Aber einen Ansatz hätte ich dir:
    Bring T1 erst mal in ein Format, mit dem du arbeiten kannst.

    Visual Basic-Quellcode

    1. ​Tabelle1.Columns("A:A").TextToColumns Destination:=Tabelle1.Range("B2"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Semicolon:=True, FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2))


    Vermutlich kannst du dann mit ganz einfachen SVERWEIS-Formeln oder anderen Lookups den Vergleich mit T2 schaffen.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Hallo Petaod, Danke für deine Mail. Da hast du recht, sehr sehr warm und eigentlich zu schön zum arbeiten. Dennoch: Wenn ich mit z.B. Sub Formate () deinen Code laufen lasse, bekomme ich den Fehler: "Laufzeitfehler 1004. Es werden keine Daten zur Analyse markiert." Muss ich da erst Variablen dekl.? Du siehst, ist wirklich schon lange her. Ich habe jetzt im Anhang mein Beispiel um die erwünschte Lösung ergänzt. Dazu habe ich aus Tabelle 2 jeweils nach den Schlüsseln ab den grünen Attributen + darunter stehende Werte zeilenweise kopiert und dann in Tabelle1 reintransponiert. SVERWEIS braucht man glaub ich nicht, denn die Reihenfolge stimmt ja bereits. Jetzt steht in Tabelle 1 in der Zelle A hinten Attribut; Wert. Dann reinkopiert aus Tabelle 2 Wert, Attribut. Wert soll jetzt noch mit Wert verglichen werden. Passen die Werte, werden sie grün eingefärbt. Passen sie nicht, werden sie rot eingefärbt. Die Tabelle VERSB aus Tabelle2 hat ja 2 Werte untereinander und wird in der Reihenfolge Eins, Zwei, Drei , Vier, Fünf, Sechs (rot markiert) zeilenweise durchlaufen. Was man sich denke ich jeweils suchen müsste, ist der Anfangspunkt DE1_I_LVERS#, DE1_I_BSTGR# u.s.w ab dem man zeilenweise ganz nach rechts geht, und das dann spaltenweise in Tabelle 1 reinkopiert. Mir sind die Schritte eigentlich klar, aber ich kann das nicht umsetzen.
    Viele Grüsse
    VBA Begins
    Dateien

    VBA Begins schrieb:

    bekomme ich den Fehler: "Laufzeitfehler 1004. Es werden keine Daten zur Analyse markiert."
    ???
    Aber nicht in der oben angegebenen Codezeile.

    Ich sehe in der Anlage von dir keinen Code, so dass ich dir auch nicht sagen kann, woher die Fehlermeldung kommt.
    Welche Excel-Version verwendest du?
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Vergleichen Jetzt klappts

    Hallo Petaod,

    habs vorher im Tabellenblatt ausgeführt. Jetzt deinen Code in einem Modul ausgeführt und nun klappts. Sieht jetzt aus wie im beigefügten
    Anhang. In der Tabelle VERSB in Tabelle2 kann der Baustein Tarifteil bis zu 5 mal auftreten. Hier im Beispiel sind das nur 2.
    Meine Excel Version zu Hause ist von 2003. Im Geschäft 2010.

    Viele Grüsse
    VBA Begins
    Dateien
    Hallo petaod,

    bin grade am rumbasteln. Findest du den untigen Code sehr umständlich?
    Erst verwende ich deinen Code :) um Formate sauber hinzukriegen. Nach dem Code habe ich in den meisten Zelle diesen grünen Querbalken am linken oberen Rand, der einem sagt "Die Zahl in dieser Zelle ist als Text formatiert oder es ist ein Apostroph vorangestellt". Ich kann auf dieses Zeichen draufgehen und in allen Zellen der Spalte mit diesem Querbalken eine gescheite Zahl draus machen. Doch wie mache ich das im Code? Als nächstes lösche ich im Code in Tabelle 1 alle leeren Zeilen, damit ich nachher alle unterschiedlichen Wertinhalte filtern kann. Dann markiere ich in Tabelle 2 die Bereiche, die ich mit "For each Zelle in Bereich" + Wertinhalt in Tabelle 1
    kopieren möchte. Jetzt komm ich nicht weiter.... Mein Code bisher:
    Kannst Du mir weiterhelfen? Danke und viele Grüsse
    VBA Begins

    Quellcode

    1. ​Sub b()
    2. Dim Zelle As Range
    3. Dim Tabelle2_lvers As Range
    4. Dim Tabelle2_bgr As Range
    5. Dim Tabelle2_versb1 As Range
    6. Dim Tabelle2_versb2 As Range
    7. Dim Tabelle2_vp As Range
    8. Dim zeile As Long
    9. Dim zeilemax As Long
    10. Tabelle1.Columns("A:A").TextToColumns Destination:=Tabelle1.Range("B2"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Semicolon:=True, FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2))
    11. With Tabelle1
    12. zeilemax = .UsedRange.Rows.Count
    13. For zeile = zeilemax To 2 Step -1
    14. If .Range("A" & zeile).Value = "" Then
    15. .Rows(zeile).Delete
    16. End If
    17. Next zeile
    18. End With
    19. ' Suche Bereiche im Tabelle2 Blatt
    20. With Tabelle2
    21. Set Tabelle2_lvers = .Range("F2:ID2")
    22. Set Tabelle2_bstgr = .Range("F8:HD8")
    23. Set Tabelle2_versb1 = .Range("I12:IF12")
    24. Set Tabelle2_versb2 = .Range("I30:IF30")
    25. Set Tabelle2_vp = .Range("A1:IF213").Find("DE1_I_VP_NR")
    26. '....
    27. For Each Zelle In Tabelle2_lvers
    28. ' Schreibe (Kopiere) Attribut in Tabelle1.SpalteI2 bis nach unten
    29. ' Schreibe (Kopiere) Wertinhalt Attribut.Offset(0, i) in Tabelle1.SpalteH2 nach unten
    30. ' Vergleiche ab i = 2 Zeile G(i) mit Zeile H(i) (Wertinhalte vgl.) :
    31. ' wenn gleich: hellgrün einfärben, wenn ungleich: rot einfärben
    32. End Sub

    VBA Begins schrieb:

    Ich kann auf dieses Zeichen draufgehen und in allen Zellen der Spalte mit diesem Querbalken eine gescheite Zahl draus machen.
    Die jeweils zweite Zahl für die entsprechenden Spalten im FieldInfo-Array auf 1 setzen

    VBA Begins schrieb:

    Schreibe (Kopiere) Wertinhalt Attribut.Offset(0, i) in Tabelle1.SpalteH2 nach unten
    FillDown

    VBA Begins schrieb:

    wenn gleich: hellgrün einfärben, wenn ungleich: rot einfärben
    If Tabelle1.Cells(r,c).Value = Tabelle2.Cells(x,y).Value Then Tabelle1.Cells(r,c).Interior.Color=...

    Eleganter wäre das Ganze wirklich mit SVERWEIS und "Bedingte Formatierung", aber das ist mir jetzt zu kompliziert zum Erklären, zumal ich dein eigentliches Problem in Gänze nicht verstanden habe.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Vergleichen im Endspurt

    Hallo Petaod,
    jetzt bin ich schon ziemlich weit, du würdest das sicher effektiver und 10 mal kürzer halten.
    Was mir jetzt noch fehlt, ist der Vergleich mit einfärben. Und die Geschichte mit dem Format in Zahl umwandeln in Spalte G nach deinem Formatumwandlungscode. Spalten A,B,C und E könnten eigentlich nach der Formatumwandlung ausgeblendet werden, weiß aber nicht, wie das im Code geht.
    Viele Grüsse
    VBA Begins
    Code:

    Quellcode

    1. Option Explicit
    2. Sub b()
    3. Dim Zelle As Range
    4. Dim Tabelle2_lvers As Range
    5. Dim Tabelle2_bgr As Range
    6. Dim Tabelle2_versb1 As Range
    7. Dim Tabelle2_versb2 As Range
    8. Dim Tabelle2_vp As Range
    9. Dim zeile As Long
    10. Dim zeilemax As Long
    11. Tabelle1.Columns("A:A").TextToColumns Destination:=Tabelle1.Range("B2"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Semicolon:=True, FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2))
    12. With Tabelle1
    13. zeilemax = .UsedRange.Rows.Count
    14. For zeile = zeilemax To 2 Step -1
    15. If .Range("A" & zeile).Value = "" Then
    16. .Rows(zeile).Delete
    17. End If
    18. Next zeile
    19. End With
    20. ' Suche Bereiche im Tabelle2 Blatt
    21. 'With Tabelle2
    22. 'Set Tabelle2_lvers = .Range("F2:ID2")
    23. 'Set Tabelle2_bstgr = .Range("F8:HD8")
    24. 'Set Tabelle2_versb1 = .Range("I12:IF12")
    25. 'Set Tabelle2_versb2 = .Range("I30:IF30")
    26. 'Set Tabelle2_vp = .Range("A1:IF213").Find("DE1_I_VP_NR")
    27. '....
    28. 'LVERS
    29. Tabelle2.Range("F2:ID2").Copy
    30. Tabelle1.Range("I2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    31. Tabelle2.Range("F3:ID3").Copy
    32. Tabelle1.Range("H2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    33. 'BSTGR
    34. Tabelle2.Range("F8:HD8").Copy
    35. Tabelle1.Range("I235").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    36. Tabelle2.Range("F9:HD9").Copy
    37. Tabelle1.Range("H235").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    38. 'VERSB1
    39. Tabelle2.Range("I12:IF12").Copy
    40. Tabelle1.Range("I443").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    41. Tabelle2.Range("I13:IF13").Copy
    42. Tabelle1.Range("H443").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    43. 'VERSB1
    44. Tabelle2.Range("I12:IF12").Copy
    45. Tabelle1.Range("I675").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    46. Tabelle2.Range("I14:IF14").Copy
    47. Tabelle1.Range("H675").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    48. 'VERSB2
    49. Tabelle2.Range("I30:IF30").Copy
    50. Tabelle1.Range("I907").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    51. Tabelle2.Range("I31:IF31").Copy
    52. Tabelle1.Range("H907").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    53. 'VERSB2
    54. Tabelle2.Range("I30:IF30").Copy
    55. Tabelle1.Range("I1139").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    56. Tabelle2.Range("I32:IF32").Copy
    57. Tabelle1.Range("H1139").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    58. 'VERSB3
    59. Tabelle2.Range("I48:IF48").Copy
    60. Tabelle1.Range("I1371").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    61. Tabelle2.Range("I49:IF49").Copy
    62. Tabelle1.Range("H1371").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    63. 'VERSB3
    64. Tabelle2.Range("I48:IF48").Copy
    65. Tabelle1.Range("I1495").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    66. Tabelle2.Range("I50:IF50").Copy
    67. Tabelle1.Range("H1495").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    68. 'VP
    69. Tabelle2.Range("E66:Y66").Copy
    70. Tabelle1.Range("I1619").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    71. Tabelle2.Range("E67:Y67").Copy
    72. Tabelle1.Range("H1619").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    73. 'AVHB
    74. Tabelle2.Range("E80:I80").Copy
    75. Tabelle1.Range("I1640").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    76. Tabelle2.Range("E81:I81").Copy
    77. Tabelle1.Range("H1640").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    78. 'AVHB
    79. Tabelle2.Range("E80:I80").Copy
    80. Tabelle1.Range("I1645").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    81. Tabelle2.Range("E82:I82").Copy
    82. Tabelle1.Range("H1645").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    83. 'For Each Zelle In Tabelle2_lvers
    84. ' Schreibe (Kopiere) Attribut in Tabelle1.SpalteI2 bis nach unten
    85. ' Schreibe (Kopiere) Wertinhalt Attribut.Offset(0, i) in Tabelle1.SpalteH2 nach unten
    86. ' Vergleiche ab i = 2 Zeile G(i) mit Zeile H(i) (Wertinhalte vgl.) :
    87. ' wenn gleich: hellgrün einfärben, wenn ungleich: rot einfärben
    88. End Sub
    Dateien
    Hallo Petaod,
    hatte gar nicht gesehen, dass du in der Zwischenzeit geantwortet hattest. Danke, das mit dem Format hat sehr gut geklappt. Meine Kopiererei von Tabelle2 in Tabelle1 lässt sich sicher in ein, zwei Zeilen schreiben; (und nicht in 10 Bereiche unterteilen). Trotzdem habe ich schon ein gutes Ergebnis.
    Der Rest vom Code sieht so aus:

    Quellcode

    1. ​For i = 2 To 1650
    2. If Tabelle1.Cells(i, 7).Value = Tabelle1.Cells(i, 8).Value Then Tabelle1.Cells(i, 7).Interior.ColorIndex = 4 Else Tabelle1.Cells(i, 7).Interior.ColorIndex = 6
    3. Next i

    ich würde gerne in der letzten Zeile im else-Zweig noch was ergänzen, weiß aber nicht wie: wenn Wertinhalte nicht gleich sind, dann möchte ich nicht nur Colorindex = 6, sondern das in der Spalte J ein "x" reingeschrieben wird, damit ich am Ende danach sortieren kann. Auch schön wäre, wenn das Ergebnis von Spalte G rechtsbündig und von Spalte H linksbündig erscheinen würde. Wie geht das?
    Kosmetik wäre also nach dem Formatieren Spalten A,B,C und E ausblenden, die Links-und Rechtsbündigkeit, danach noch in Zeile 1 jeweils die Überschriften reinschreiben und einen Filter setzen nach Spalte J mit den x-en.
    Bis hierher mal vielen Dank und gute Nacht
    VBA Begins

    VBA Begins schrieb:

    das in der Spalte J ein "x" reingeschrieben wird, damit ich am Ende danach sortieren kann
    Du kannst auch nach Farben sortieren.

    VBA Begins schrieb:

    nach dem Formatieren Spalten A,B,C und E ausblenden, die Links-und Rechtsbündigkeit, danach noch in Zeile 1 jeweils die Überschriften reinschreiben und einen Filter setzen
    Aber so was lässt sich dich extrem einfach mit dem Macro-Recorder rausfinden.
    Ignorier halt die Mausklicks, also alles was nach Activate/ActiveSheet und Selection/Select und adressier dafür die Objekte direkt.
    Aber welche Properties und welche Methoden wie verwendet werden, kriegst du damit auf dem Silbertablett serviert.

    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Hallo Petaod,
    ja mit dem Makrorrekorder geht das einfach, danke. Ich wusste aber auch, dass du bei Selection und Activate immer schimpfst und dachte, du machst das dann anders. Irgendwie klappt das jetzt zwar, aber ich bin nicht zufrieden. Dieses Beispiel muss ich c.a. 1000 mal durchführen! Die Attribute und ihre Reihenfolge in Tabelle2 und Tabelle 1 sind zwar immer in exakt derselben Reihenfolge; doch ab der Tabelle VERSBi in Tabelle2 kann der Baustein Tarifteil bis zu 5 mal auftreten, d.h. unter der Zeile VERSBi werden dann 5 mal zeilenweise untereinander die Werte von VERSBi durchlaufen. Hier im Beispiel sind das nur 2 Werte zeilenweise unterhalb von VERSBi. Hier bräuchte ich sowas wie einen Findbefehl, der die Zelle unterhalb VERSBi abtastet, ob da was drin steht oder nicht. Und wenn da z.B. drei rauskommt, dann den Bereich I13:IF13 bis I15:1F15 unter VERSB1 zeilenweise kopieren und spaltenweise in Tabelle1 reinkopieren. Denn je nachdem, wieviele Wertezeilen (Tarifteile) unter VERSBi stehen, verschiebt sich dann die nächste Tabelle VP1 und AVHB in der Tabelle 1 beim runterkopieren nach unten. Kannst Du das hinschreiben?
    Danke und viele Grüsse
    VBA Begins
    Hallo Petaod,
    nochmals zum Vergleichen. Ich glaube, das Thema ist nicht so trivial und nicht mit SVERWEIS und bed. Formatierung zu lösen. Dafür bräuchte man x-verschiedene bed. Formatierungsvorlagen? Denn, nicht nur, dass unter Tabelle2.VERSB(Teil1).Range(B12) eine, zwei, bis zu 5 verschiedene Zeilen stehen können. (Tabelle2.VERSB(Teil2+3) haben immer gleich viele Zeilen wie VERSB(Teil1)). Danach muss man erst mal in Tabelle1 in Spalte H und I die letzte hinkopierte Zelle finden (bzw. die erste freie Zeile). Da fängt dann die Zeile Tabelle2.VP.Range(B66) an. Und die Zeile fängt ja, je nachdem wieviele Zeilen in VERSB(Teil1,2,3) waren, weiter oben oder weiter unten an. Ausserdem kann VP selbst wieder 2 Zeilen als Werte unter sich haben. Ebenso kann das dann folgende Tabelle2.AVB.Range(B80) wiederum bis zu 3 Zeilen haben. Deshalb glaube ich, dass ich das nur mit einer Schleifenprogrammierung erschlagen kann.
    Mein erster Ansatz ist: (aber mir fehlen soviele Grundlagen beim erweitern von Cells+Range mit Laufindex t:

    Quellcode

    1. 'VERSB1
    2. For t = 0 To 3
    3. If Tabelle2.Range("C14+t") = "" Then Tabelle2.Range("I12:IF12").Copy
    4. Tabelle1.Range("I(443+t*232)").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    5. Tabelle2.Range("I13+t:IF13+t").Copy
    6. Tabelle1.Range("H(443+t*232)").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    7. Next t

    Am Anfang prüfe ich, wieviele Zeilen VERSB1 hat mit "C14+t" (wie schreibt man das richtig?)="leer".
    Je nachdem, wieviele Zeilen ich habe, muss ich dann in der nächsten Zeile im Programm je um t*232 (so viele Zellen haben die Zeilen unter VERSB1)Zellen in Tabelle1 nach unten kopieren. Oben bleibt das
    Then Tabelle2.Range("I12:IF12").Copy fix, denn die Attributzeile 12 ist ja immer fix. Die Wertezeile
    Tabelle2.Range("I13+t:IF13+t").Copy ändert sich natürlich mit t (WertZeilen unter VERSB1).
    Petaod, denkst du, der Ansatz ist richtig, und- kannst du ihn mir bitte richtig hinschreiben?

    VBA Begins schrieb:

    Ich wusste aber auch, dass du bei Selection und Activate immer schimpfst und dachte, du machst das dann anders
    Wenn du das Excel-Objektmodell im Kopf hast, benötigst du keinen Macrorecorder ;)
    Aber für Ungeübte ist der Recorder zum Spicken erlaubt.
    Du musst ja den Code nicht 1:1 übernehmen, aber als Ideengeber, welche Objekte und Methoden verwendet werden, ist das durchaus legitim.

    VBA Begins schrieb:

    mit "C14+t" (wie schreibt man das richtig?)="leer".
    If IsEmpty(Range("C" & 14+t))

    VBA Begins schrieb:

    Tabelle2.Range("I13+t:IF13+t").Copy
    ​Tabelle2.Range("I" & 13+t & ":IF" & 13+t).Copy
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Vergleichen

    Hallo Petaod,

    Danke für deine Antwort. Ich hab mir jetzt mal einen Code gebastelt. Im Anhang das zugehörige Sheet.
    Im 2.Anhang steht noch ein Beispiel, das verdeutlicht, wie die Daten in Tabelle 2 auch reinkommen können. Mit 5 Wertezeilen unterhalb VERSB1,2,3.
    Die Struktur und Anzahl der Attribute bleibt aber immer dieselbe.
    In Tabelle2 in Anhang1 habe ich alles rot markiert, was ich lösche. Da bleibt dann nur noch ein
    Rumpf von Wertezeilen übrig, die ich dann in G2 und F2 in Tabelle1 nebeneinander stellen will.
    Leider macht mein Programm den vorletzten Schritt, das senkrecht reinkopieren in G2 in Tabelle 1 nicht.
    Was fehlt da?
    Wäre schön, wenn du draufschauen könntest.
    Danke und Viele Grüsse aus S
    VBA Begins

    Quellcode

    1. Sub Probieren()
    2. '
    3. ' erster Makro
    4. '
    5. 'Aufzeichnung für Löschen Zeilen in Tabelle2
    6. ' Es bleiben nur übrig die Wertezeilen, welche nachher mit Spalte 6 in Tabelle1
    7. 'verglichen werden sollen
    8. Rows("1:1").Select
    9. Range("B1").Activate
    10. Selection.Delete Shift:=xlUp
    11. Range("F1:F2").Select
    12. Range(Selection, Selection.End(xlToRight)).Select
    13. Selection.Cut
    14. Range("A1").Select
    15. ActiveSheet.Paste
    16. Range("F7:F8").Select
    17. Range(Selection, Selection.End(xlToRight)).Select
    18. Selection.Cut
    19. Range("A3").Select
    20. ActiveSheet.Paste
    21. Range("A1").Select
    22. Range(Selection, Selection.End(xlToRight)).Select
    23. Range("HZ1").Select
    24. ActiveCell.FormulaR1C1 = "x"
    25. Range("HZ2").Select
    26. ActiveCell.FormulaR1C1 = "x"
    27. Range("GZ3").Select
    28. ActiveCell.FormulaR1C1 = "x"
    29. Range("GZ4").Select
    30. ActiveCell.FormulaR1C1 = "x"
    31. Range("GZ7").Select
    32. Rows("5:10").Select
    33. Selection.Delete Shift:=xlUp
    34. Range("I5:I11").Select
    35. Range(Selection, Selection.End(xlToRight)).Select
    36. Selection.Cut
    37. ActiveWindow.ScrollColumn = 3
    38. ActiveWindow.ScrollColumn = 1
    39. Range("A5").Select
    40. ActiveSheet.Paste
    41. Range("I23:I29").Select
    42. Range(Selection, Selection.End(xlToRight)).Select
    43. Selection.Cut
    44. ActiveWindow.ScrollColumn = 3
    45. ActiveWindow.ScrollColumn = 2
    46. ActiveWindow.ScrollColumn = 1
    47. Range("A11").Select
    48. ActiveSheet.Paste
    49. Range("I41:I48").Select
    50. Range(Selection, Selection.End(xlToRight)).Select
    51. Selection.Cut
    52. ActiveWindow.ScrollColumn = 3
    53. ActiveWindow.ScrollColumn = 2
    54. ActiveWindow.ScrollColumn = 1
    55. Range("A17").Select
    56. ActiveSheet.Paste
    57. Range("E59:E61").Select
    58. Range(Selection, Selection.End(xlToRight)).Select
    59. Selection.Cut
    60. Range("A23").Select
    61. ActiveSheet.Paste
    62. ActiveWindow.SmallScroll Down:=6
    63. Range("E73").Select
    64. Range(Selection, Selection.End(xlDown)).Select
    65. Range(Selection, Selection.End(xlToRight)).Select
    66. Selection.Cut
    67. Range("A26").Select
    68. ActiveSheet.Paste
    69. Rows("42:42").Select
    70. Range(Selection, Selection.End(xlDown)).Select
    71. Selection.Delete Shift:=xlUp
    72. Rows("41:41").Select
    73. Selection.Delete Shift:=xlUp
    74. Range("I26").Select
    75. ActiveCell.FormulaR1C1 = "x"
    76. Range("I27").Select
    77. ActiveCell.FormulaR1C1 = "x"
    78. Range("I28").Select
    79. ActiveCell.FormulaR1C1 = "x"
    80. Range("I29").Select
    81. ActiveCell.FormulaR1C1 = "x"
    82. Range("A23").Select
    83. Range(Selection, Selection.End(xlToRight)).Select
    84. Range("DU23").Select
    85. ActiveCell.FormulaR1C1 = "x"
    86. Range("DU24").Select
    87. ActiveCell.FormulaR1C1 = "x"
    88. Range("DU25").Select
    89. ActiveCell.FormulaR1C1 = "x"
    90. Range("A17").Select
    91. Range(Selection, Selection.End(xlToRight)).Select
    92. Range("IG12").Select
    93. ActiveCell.FormulaR1C1 = "x"
    94. Selection.AutoFill Destination:=Range("IG12:IG20"), Type:=xlFillDefault
    95. Range("IG12:IG20").Select
    96. ActiveWindow.SmallScroll Down:=-24
    97. Range("HY5").Select
    98. ActiveCell.FormulaR1C1 = "x"
    99. Selection.AutoFill Destination:=Range("HY5:HY11"), Type:=xlFillDefault
    100. Range("HY5:HY11").Select
    101. Range("V23").Select
    102. ActiveCell.FormulaR1C1 = "x"
    103. Selection.AutoFill Destination:=Range("V23:V25"), Type:=xlFillDefault
    104. Range("V23:V25").Select
    105. Range("IG20").Select
    106. Selection.AutoFill Destination:=Range("IG20:IG22"), Type:=xlFillDefault
    107. Range("IG20:IG22").Select
    108. ActiveWindow.SmallScroll Down:=-3
    109. Rows("1:1").Select
    110. Selection.Delete Shift:=xlUp
    111. Rows("2:2").Select
    112. Selection.Delete Shift:=xlUp
    113. Rows("3:3").Select
    114. Selection.Delete Shift:=xlUp
    115. Rows("8:8").Select
    116. Selection.Delete Shift:=xlUp
    117. Rows("13:13").Select
    118. Selection.Delete Shift:=xlUp
    119. Rows("18:18").Select
    120. Selection.Delete Shift:=xlUp
    121. Rows("20:20").Select
    122. Selection.Delete Shift:=xlUp
    123. ActiveWindow.SmallScroll Down:=-18
    124. Range("A1").Select
    125. 'Dieses Löschen garantiert immer die richtige Anzahl an VERSB-, VP-, und AVB-Wertedaten
    126. 'in Tabelle2, d.h. hier werden dann die entstehenden Lücken zwischen den Tabellen gelöscht
    127. zeilemax = Tabelle2.UsedRange.Rows.Count
    128. For zeile = zeilemax To 2 Step -1
    129. If Tabelle2.Range("A" & zeile).Value = "" Then
    130. Tabelle2.Rows(zeile).Delete
    131. End If
    132. Next zeile
    133. 'hier nehme ich den verbleibenden Rest nach zusammenstreichen in Tabelle2 und kopiere das von links nach rechts
    134. 'spaltenweise in G2 nach unten weg in Tabelle1
    135. With Tabelle2
    136. t = 1
    137. ergebnis_zeile = 1
    138. Do Until Tabelle2.Cells(t, 1) = ""
    139. u = 1
    140. Do Until Tabelle2.Cells(t, u) <> "x"
    141. ergebnis_zeile = ergebnis_zeile + 1
    142. Tabelle1.Cells(ergebnis_zeile, 7) = Tabelle2.Cells(t, u)
    143. u = u + 1
    144. Loop
    145. t = t + 1
    146. Loop
    147. End With
    148. 'Vergleichsschleife auf Tabelle1 Werte Spalte7 vgl mit Werte Spalte6
    149. For i = 2 To 1650
    150. If Tabelle1.Cells(i, 6).Value = Tabelle1.Cells(i, 7).Value Then Tabelle1.Cells(i, 6).Interior.ColorIndex = 4 Else Tabelle1.Cells(i, 7).Interior.ColorIndex = 6
    151. Next i
    152. 'Überschriften auf Tabelle1
    153. With Tabelle1
    154. .Range("A1").Value = ONR
    155. .Range("A2").Value = Nr
    156. .Range("A3").Value = Tabelle
    157. .Range("A4").Value = ANR
    158. .Range("A5").Value = ABS_Tabelle
    159. .Range("A6").Value = ABS_Wert
    160. .Range("A7").Value = TD1_Wert
    161. End With
    162. End Sub
    Dateien

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VBA Begins“ () aus folgendem Grund: 2. Anhang

    Hallo Petaod,

    eigentlich hat mein unschönes Programm jetzt nur noch n kleines Problem in der Passage

    Quellcode

    1. ​t = 1
    2. ergebnis_zeile = 1
    3. Do Until Tabelle2.Cells(t, 1) = ""
    4. s = 1
    5. Do Until Tabelle2.Cells(t, s) <> x
    6. ergebnis_zeile = ergebnis_zeile + 1
    7. Tabelle1.Cells(ergebnis_zeile, 7) = Tabelle2.Cells(t, s)
    8. s = s + 1
    9. Loop
    10. t = t + 1
    11. Loop

    Die Variable s läuft nicht mit, bleibt immer bei 1?
    Die wird immer auf 1 zurück gesetzt.
    Wenn sie in der inneren Schleife nicht hoch läuft, kann das nur bedeuten, dass die Eingangsbedingung nie erreicht wird, also Zeile 7-9 gar nie durchlaufen wird.

    Geh im Debugger einzelschrittweise durch und beobachte, warum das Programm nicht das tut, was du meinst, dass es tun sollte.
    Wenn du in Zeile 6 bist: Was steht in Tabelle2.Cells(t, s), was steht in x?
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --