Anzeige
Archiv - Navigation
1556to1560
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Name Arbeitsmappe auslesen und Wert suchen
04.05.2017 22:15:47
Thomas
Hallo liebe VBA-Gemeinde!
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

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Name Arbeitsmappe auslesen und Wert suchen
05.05.2017 05:32:07
fcs
Hallo Thomas,
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))

Du hast die Syntax der Funktion "Instr" nicht korrekt beachtet.
Der 3. Parameter ist die Anzahl der Zeichen die übernommen werden sollen, nicht die Position des letzten Zeichens.
Die Code-Zeile muss bei verkürzter Datumsangabe mit 8 Zeichen also geändert werden in:
For ldtDays = CDate(InStr(lstrStart, 12, 8)) To CDate(InStr(lstrEnd, 12, 8))
LG
Franz
Anzeige
AW: Name Arbeitsmappe auslesen und Wert suchen
05.05.2017 10:29:54
Thomas
Hallo Franz!
Danke für deine Antwort, jedoch kommt jetzt ein Debugger!
If Dir(lstrPath & ldtDays & ".xlsx") "" Then
Laufzeitfehler 52: Dateiname oder -Nummer falsch.
AW: Name Arbeitsmappe auslesen und Wert suchen
05.05.2017 10:32:11
Thomas
Da fällt mir gerade ein, dass in der Inputbox das Jahr 2017 ausgewählt wird.
das Jahr jedoch mit 17 angegeben ist. Könnte das den Fehler verursachen?
AW: Name Arbeitsmappe auslesen und Wert suchen
05.05.2017 13:45:12
fcs
Hallo Thomas,
das Jahr muss natürlch in der Kurzform in den Suchstring für den Dateinamen eingebaut werden, aber ebenso "Transfer - " und die Uhrzeit.
Auch die For-Zeile muss anders aussehen- es reicht eine einfache Umwandlung des Datum-Textes per CDate in eine ganze Zahl.
Da deine Beispieldateien in Spate A keine Daten enthalten musste ich auch die Anweisungen zur Ermittlung der letzten Daten-Zeile anpassen (Spalte 1 muss in Spalte 3 geändert werden).
LG
Franz
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
Dim strFileSuch As String, strFile As String
Dim wkbTrans As Workbook
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(lstrStart) To CDate(lstrEnd)
'Datei-Suchstring für Dateisuche mit Funktion Dir
strFileSuch = "Transfer - " & Format(ldtDays, "DD.MM.YY") & " ?.?.xlsx"
'Datei(en) suchen
strFile = Dir(lstrPath & strFileSuch, vbNormal)
Do Until strFile = ""
larCur = Range("C2:G" & Cells(Rows.Count, 3).End(xlUp).Row)
'Datei schreibgeschützt öffnen
Set wkbTrans = Workbooks.Open(lstrPath & strFile, ReadOnly:=True)
With wkbTrans.Worksheets(1)
larFile = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp).Offset(0, 4)). _
Value2
End With
wkbTrans.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 ''" & strFile & "'', Zeile " _
& liIdxFile + 1 & vbCrLf
End If
Next
Next
'nächste Datei suchen
strFile = Dir
Loop
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

Anzeige
AW: Name Arbeitsmappe auslesen und Wert suchen
05.05.2017 21:25:04
Thomas
Hallo Franz!
Es funktioniert bis auf eine Kleinigkeit. Beim Test bin ich darauf gekommen.
Wenn Spalte C (Kundennummer) "und" Spalte G (Betrag) in den Arbeitsmappen übereinstimmen, dann soll es auf MsgBox ausgewiesen werden. Denn das deutet womöglich auf eine Doppelbuchung hin. Und das ist der Sinn des Programms.
Momentan ist es so, wenn eine gleiche Kundennummer oder gleicher Betrag gefunden wird, dann wird auf MsGBox ausgewiesen.
Kannst du bitte noch weiterhelfen?
AW: Name Arbeitsmappe auslesen und Wert suchen
05.05.2017 22:24:09
fcs
Hallo Thomas,
ich nehme an, dass in der Prüfung die Spalten-Nummern nicht korrekt sind.
                    If larCur(liIdxCur, 1) = larFile(liIdxFile, 1) And _
larCur(liIdxCur, 2) = larFile(liIdxFile, 2) Then

ändern in
                    If larCur(liIdxCur, 1) = larFile(liIdxFile, 1) And _
larCur(liIdxCur, 5) = larFile(liIdxFile, 5) Then

sollte helfen. Denn in den Array steht die Kunden-Nr. in Spalte 1 und der Betrag in Spalte 5.
LG
Franz
Anzeige
AW: Name Arbeitsmappe auslesen und Wert suchen
05.05.2017 22:58:27
Thomas
Hallo Franz!
Vielen Dank! Hab´s jetzt mehrere Male getestet. Jetzt stimmen die Angaben in der MsgBox.
Auch dir Thorsten möchte ich an dieser Stelle nochmal Danke sagen.
Ihr habt mir sehr geholfen!!
VG
Thomas

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige