If Anweisung in bestehenden Code
Stefan
hätte noch gerne eine kleine Verbesserung an meinem Code, bring das aber leider nicht
selbst auf die Reihe...
Der Code checkt Spalte C zweier Tabellen (alt/neu) wenn gleich schreibt er den Wert aus Spalte 8 von
der Alt in die neu rein. Kann er eine Zeile aus Spalte C nicht zuordnen, so legt er eine Tabelle "Diff1-Vorb" an und schreibt dann die Zeile rein, die unterschiedlich ist.
Problem: hier möchte ich noch gerne eine If Anweisung rein haben, der das ganze mit der Diff1-Vorb nur dann macht, wenn in der alt-Tabelle in der Zeile der Spalte 8 auch was drin steht.
Wenn leer, dann keine Aktion...
With wks_VORB_Alt
For Zeile_Alt = 12 To 14: ' Zeile 12 bis 14 checken
'Wert in Altdatei-Spalte C
vWert_B = .Cells(Zeile_Alt, 3).Value
If vWert_B "" Then
'Wert in neuer Datei Spalte C suchen
With wks_VORB_Neu
Set Zelle_Wert_B = .Range(.Cells(12, 3), .Cells(14, 3)) _
.Find(what:=vWert_B, LookIn:=xlValues, lookat:=xlWhole) ' Zeile 12 bis 14 checken Spalte C
End With
If Zelle_Wert_B Is Nothing Then 'Wert in neuer Vorlage nicht vorhanden
If wks_diff Is Nothing Then
*** hier müsste die neue Abfrage rein ***
'Tabellenblatt für Abweichungen anlegen
Set wks_diff = wbNeu.Worksheets.Add(After:=wks_DIFFALL_Neu)
wks_diff.Name = "Diff1-Vorb"
'Spaltenbreiten in Differenzblatt an Alt-Datei anpassen
For Spalte = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Column
wks_diff.Columns(Spalte).ColumnWidth = .Columns(Spalte).ColumnWidth
Next
End If
Zeile_Diff = Zeile_Diff + 1
.Rows(Zeile_Alt).Copy Destination:=wks_diff.Cells(Zeile_Diff, 1)
Else
'Werte aus Spalten H von Alt nach Neu kopieren wenn nicht gesperrt ist
If .Cells(Zeile_Alt, 8).AllowEdit = False Then
Else
.Cells(Zeile_Alt, 8).Copy _
Destination:=wks_VORB_Neu.Cells(Zelle_Wert_B.Row, 8)
End If