ich habe ein Makro welches mir es ermöglicht eine Excel-Importdatei zu öffnen und Teile davon in ein neues Tabellenblatt schreibt.
Neu ist, dass ich die Einträge aus Spalte 2 der zu importierenden Datei vorher gegen eine Masterdatei vergleichen will.
Die zu importierende Datei hat jedoch in Spalte 2 mehr Zeichen als die Masterdatei, somit sollen nur die ersten 3 Zeichen gegen die Masterdatei geprüft werden.
Folgendes habe ich versucht, was jedoch scheitert:
letzte = WsQ.Cells(WsQ.Rows.Count, 1).End(xlUp).Row
ImportListe = WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Row
For i = 2 To letzte
a = Application.Match(WsQ.Cells(i, 2), wksQ.Columns(5), 0)
If Left(WsQ.Cells(i, 2), 3).Value = wksQ.Cells(a, 2).Value Then
WsQ.Cells(i, 3).Value = wksQ.Cells(a, 2).Value
Else
End If
Wer kann mir dabei helfen, dass nur die ersten 3 Zeichen aus der Importdatei gegen die Masterdatei geprüft wird und das für jeden Eintrag?
Sub Test()
Dim WbQ As Workbook, WbZ As Workbook, WsQ As Worksheet, wksQ As Worksheet
Dim WsZ As Worksheet, tQ As ListObject, Pfad$
Dim i As Long, letzte As Long, Speicher As String, ImportListe As Long
Dim a As Variant
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Bitte einzulesende Datei wählen..."
.AllowMultiSelect = False
If .Show -1 Then
MsgBox "Vorgang abgebrochen!", vbInformation
Exit Sub
Else: Pfad = .SelectedItems(1)
End If
End With
Set WbQ = Workbooks.Open(Pfad)
Set WsQ = WbQ.Worksheets(1)
Set WbZ = Workbooks.Add(template:=xlWBATWorksheet)
Set WsZ = WbZ.Worksheets(1)
Set wksQ = GetObject("C:\Test\Test.xlsx").Worksheets("0815")
letzte = WsQ.Cells(WsQ.Rows.Count, 1).End(xlUp).Row
ImportListe = WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Row
For i = 2 To letzte
a = Application.Match(WsQ.Cells(i, 2), wksQ.Columns(5), 0)
If Left(WsQ.Cells(i, 2), 3).Value = wksQ.Cells(a, 2).Value Then
WsQ.Cells(i, 3).Value = wksQ.Cells(a, 2).Value
Else
End If
With WsZ
.Cells(1, 1) = "Überschrift1"
.Cells(1, 2) = "Überschrift2"
End With
WsQ.Cells(i, 2).Copy
WsZ.Cells(ImportListe + 1, 7).PasteSpecial (xlPasteValuesAndNumberFormats)
ImportListe = ImportListe + 1
Next
Set WbQ = Nothing: Set WbZ = Nothing: Set WsQ = Nothing
Set WsZ = Nothing: Set tQ = Nothing: Set wksQ = Nothing
End Sub