Datenabgleich unter VBA mit dopp. Werten
05.06.2019 15:24:20
Georg
https://www.herber.de/bbs/user/130218.xlsx
Der Code funktioniert prima auch dank eurer Hilfe. Es gibt allerdings eine Hürde, die ich nicht hinkriege: relevant ab dem Teil With TB1
Im Blatt Zeiten wird abgefragt, wenn zu einem Datum (Zeile 1) die Zelle mit Wahr zu einem bestimmten Standort steht, dann prüf, ob der Standort als Datensatz mit diesem Datum im Blatt "Daten" vorhanden, wenn nicht gib die Info im Blatt Fehlzeiten aus.
Es ist allerdings so, dass an Samstagen, Sonntagen das Datum zweimal erscheint und WENN 2x wahr für dieses Datum angegeben ist, müssen im Blatt Daten auch ZWEI Datensätze vorhanden sein.
Leider deckt der Code dies nicht ab, da er ja das (erste) Datum findet und somit scheinbar alles in Ordnung ist.
Als Beispiel ist Standort 1 angegeben und als Datum 13.04 (alle relevanten Zellen sind gelb markiert).
Wie schaff ich es, dass bei 2x WAHR mit einem Datum überprüft werden kann, dass dann zwei Datensätze vorhanden sein müssen (wenn nicht wie oben: Ausgabe in Fehlzeiten)
Vielen Dank!!!
Sub TeilB()
'Fehlende Zeiten im Blatt Daten werden ermittelt
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") 'wann ist eine Bpx offen
Set TB2 = Sheets("Daten") 'die SQL Daten aus EQlab
Set TB3 = Sheets("Fehlzeiten") 'dahin werden die Fehlzeiten geschrieben.
Set WF = WorksheetFunction
Z1 = 3 'ab Zeile 3
Sp1 = 4 'Standorte stehen in Spalte D
S1 = 6 'Datum ab F
FSt2 = 1 'FindeStandorte in Spalte A
FDat2 = 5 'FindeDatum in Spalte H
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 von Zeile 3 bis L(ast)R(ow):-)'
For j = S1 To LC 'Durchlaufe alle Spalten mit Datum von Spalte H bis L(ast)C(olumn)' _
_
If .Cells(i, j) Then ' Hier wird die WAHR, FALSCH Bedingung geprüft, wenn wahr _
_
dann
'Zählenwenns()
'wenn Daten 1, Zelle 3 bis Letzte, Spalte F;
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
TB3.Columns.AutoFit
Dim y As Long
Dim lastRow As Long
lastRow = TB3.Cells(Rows.Count, 1).End(xlUp).Row
'Datum erzeugen
For y = 1 To lastRow
With TB3
.Cells(y, 2) = CDate(.Cells(y, 2))
.Cells(y, 3).Value = .Cells(y, 2).Value
.Cells(y, 3).NumberFormat = "dddd"
End With
Next y
'Überschriften
With TB3
.Rows(1).Insert xlShiftUp
.Cells(1, 1).Value = "BPx Standort"
.Cells(1, 2).Value = "Datum"
.Cells(1, 3).Value = "Wochentag"
End With
MsgBox "Fertig" & vbLf & z & " Termine fehlen"
End Sub