Datenabgleich
02.09.2019 12:54:46
Georg
bei dem Code wurde ich schon in diesem Forum unterstützt für eine ähnliche Fragestellung.
Im Blatt Daten befinden sich importierte Daten - wichtig sind Standort und Datum
Es soll nun ein Abgleich mit dem Blatt ZEITEN vorgenommen werden:#
Steht im Blatt ZEITEN zu einem Standort ab G3 der Wert WAHR, muss im Blatt DATEN ein Datensatz vorhanden sein.
Wenn nicht, soll der fehlende entsprechend dem Code im Blatt "OFFLINE" reingeschrieben werden.
Der Code macht das was er soll, allerdings sind Blatt ZEITEN manche Datumswerte doppelt mit WAHR wie z. B. der 13.07. etc. belegt.
Fehlt - um bei dem Beispiel zu bleiben - der 13.07 im Blatt Daten, soll er aber nur EINMAL in Blatt OFFLINE geschrieben werden.(Momentan wird er zweimal reingeschrieben)
Und das bekomme ich nicht hin bzw. hab keine Idee dazu!
Die Datei mit einem exemplarischen Standort ist hier abglegt und es fehlen Daten wie z. B. der 13.07. für das Testen.
https://www.herber.de/bbs/user/131786.xlsx
Der Code ist hier, vielen Dank G!
Sub Prüfen()
'die kürzere Fassung ohne, dass überprüft wird, sind an einem Datum zwei Schichten (Sa, So..) _
da
'für die Online-Offline Auswertung nicht erforderlich
Dim TB1, TB2, TB3, Z1 As Integer, S1 As Integer, LR As Long, LC As Integer
Dim i As Long, j As Integer, Sp1 As Integer
Dim FSt2 As Integer, FDat2 As Integer, WF, Z As Long
Set TB1 = Sheets("Zeiten")
Set TB2 = Sheets("Daten")
Set TB3 = Sheets("Offline")
Set WF = WorksheetFunction
Z1 = 3 'ab Zeile 3
Sp1 = 4 'Standorte stehen in Spalte D
S1 = 7 'Datum ab G
FSt2 = 2 'FindeStandorte in Spalte B
FDat2 = 3 'FindeDatum in Spalte C
LR = TB1.Cells(TB1.Rows.Count, Sp1).End(xlUp).Row 'letzte Zeile der Spalte D
LC = TB1.Cells(1, TB1.Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile 1
'reset
TB3.UsedRange.ClearContents
With TB1
For i = Z1 To LR ' Durchlaufe alle Zeilen in 'Zeiten'
For j = S1 To LC 'Durchlaufe alle Spalten mit Datum
If .Cells(i, j) Then ' Wahr
'Zählenwenns()
If WF.CountIfs(TB2.Columns(FSt2), .Cells(i, Sp1), TB2.Columns(FDat2), . _
Cells(1, j)) = 0 Then
TB3.Cells(Z + 1, 1) = .Cells(i, Sp1)
TB3.Cells(Z + 1, 2) = Format(.Cells(1, j), "DD.MM.YYYY")
Z = Z + 1
End If
End If
Next j
Next i
End With
MsgBox "Fertig" & vbLf & Z & " Termine fehlen"
End Sub