Ich komm einfach nicht mehr weiter und bitte um Eure Hilfe.
Thorsten hat schon klasse Arbeit geleistet. Der einspielte Quelltext ist alleine
seine Arbeit. Ich habe nur noch Anpassungen gemacht, die nicht der Rede wert sind.
In Laufwerk D befinden sich Dateien, die wie folgt gespeichert werden:
Datum Uhrzeit
Beispiel: Transfer - 02.05.17 10.00
Transfer - 02.05.17 12.51
Transfer - 02.05.17 16.01
Transfer - 03.05.17 10.05
Transfer - 03.05.17 13.11
Transfer - 03.05.17 14.21
usw.
Pro Tag also drei Mappen.
@Thorsten
Heute konnte ich mich davon überzeugen, dass es wirklich genau so abgespeichert wird.
Die gesuchten Spalten wurden wieder abgeändert. Zuerst waren es Spalte A und B, jetzt
sind es C und G. Das hab ich in deinen Code schon geändert. So bleibt es jetzt auch.
Was ich jetzt nicht mehr schaffe ist, dass über die Inputbox nur das Datum der in Laufwerk D gespeicherten Arbeitsmappe ausgelesen wird.
Die Werte sollen dann mit der aktuellen Mappe verglichen werden und
doppelte Einträge in einer MsgBox ausgegeben werden.
Thorstens Code funktioniert nur, wenn die Arbeitsmappen wie folgt abgespeichert werden: z. B. 02.05.2017. War natürlich mein Fehler, da ich ihm diese Info gab.
Leider stellte ich dann in der Arbeit fest, dass die Dateien wie oben abgespeichert werden. Thorsten gab mir den Tip, dass unter Umständen InStr() helfen könnte.
Wenn ich es richtig ausgezählt habe steht das Datum an Stellen 12 bis 19.
Daher habe ich die Zeile wie folgt ausgebessert.
For ldtDays = CDate(InStr(lstrStart, 12, 19)) To CDate(InStr(lstrEnd, 12, 19))
Leider ohne Erfolg.
Kann mir bitte wer weiter helfen?
Es wäre schön, wenn Thorstens Programm doch noch zum Laufen gebracht wird.
Beispieldateien: https://www.herber.de/bbs/user/113328.xlsm. Das ist Thorstens Arbeit
https://www.herber.de/bbs/user/113329.xlsx. Das ist die Mappe mit dem Namen "Transfer - 02.05.17 10.00"
Sub sbMsgBox()
Dim lstrStart As String, lstrEnd As String, ldtDays As Date, lstrMsgBox As String, lstrPath _
_
_
_
_
As String
Dim larCur() As Variant, larFile() As Variant, liIdxCur As Integer, liIdxFile As Integer
With ufDate
lstrStart = .cmbStD.Text & "." & .cmbStM.Text & "." & .cmbStY.Text
lstrEnd = .cmbEdD.Text & "." & .cmbEdM.Text & "." & .cmbEdY.Text
End With
If CDate(lstrStart) > CDate(lstrEnd) Then
MsgBox "Das Start-Datum ist größer als das End-Datum." & vbCrLf & "Bitte _
korrigieren", vbExclamation, "Hinweis"
Exit Sub
End If
Application.ScreenUpdating = False
lstrPath = "D:\Buchungen\" 'anpassen, wenn erforderlich!
lstrPath = IIf(Right(lstrPath, 1) = "\", lstrPath, lstrPath & "\")
For ldtDays = CDate(InStr(lstrStart, 12, 19)) To CDate(InStr(lstrEnd, 12, 19))
If Dir(lstrPath & ldtDays & ".xlsx") "" Then
larCur = Range("C2:G" & Cells(Rows.Count, 1).End(xlUp).Row)
Workbooks.Open lstrPath & ldtDays & ".xlsx"
larFile = Range("C2:G" & Cells(Rows.Count, 1).End(xlUp).Row)
ActiveWorkbook.Close False
For liIdxCur = 1 To UBound(larCur, 1)
For liIdxFile = 1 To UBound(larFile, 1)
If larCur(liIdxCur, 1) = larFile(liIdxFile, 1) And _
larCur(liIdxCur, 2) = larFile(liIdxFile, 2) Then
lstrMsgBox = lstrMsgBox & "Datei ''" & ThisWorkbook.Name & " _
_
_
_
_
'', Zeile " & liIdxCur + 1 & " gefunden in Datei ''" & ldtDays & ".xlsx'', Zeile " & liIdxFile + _
_
_
_
1 & vbCrLf
End If
Next
Next
End If
Next
Application.ScreenUpdating = True
If lstrMsgBox = "" Then
MsgBox "Es existieren keine Dateien mit Namen aus dem angegebenen Datumsbereich. _
_
_
_
_
", vbExclamation, "Hinweis"
Exit Sub
Else
MsgBox lstrMsgBox, , "doppelte Werte"
End If
End Sub