Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1736to1740
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
Inhaltsverzeichnis

Teile eines Eintrages vergleichen

Teile eines Eintrages vergleichen
05.02.2020 16:02:02
Tim
Hallo zusammen,
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Teile eines Eintrages vergleichen
05.02.2020 16:34:46
Piet
Hallo
statt Match kann man zwei For Next ineinander laufen lassen. Dazu benotigt man auch zwei "letzte" Variable! Dürfte von der Laufzeit etwas länger sein, aber wenn es klappt .....
mfg Piet
Dim a, i, j, x
a = 2  '1.Zeile
For i = 2 To letzte
x = a  'a retten
For j = a To letzte_2 + 1
If Left(WsQ.Cells(i, 2), 3) = Left(wksQ.Cells(j, 2), 3) Then
WsQ.Cells(i, 3).Value = wksQ.Cells(a, 2).Value
a = j: Exit For
End If
Next j
If a > letzte_2 Then a = x
Next l

AW: Teile eines Eintrages vergleichen
05.02.2020 17:02:18
Lutz
Hallo Tim,
mit
a = Application.Match(WsQ.Cells(i, 2), wksQ.Columns(5), 0)
suchst Du nach der genauen Übereinstimmung, die es nicht gibt.
Probier mal
a = Application.Match(Left(WsQ.Cells(i, 2), 3), wksQ.Columns(5), 0)
Gruß,
Lutz
Anzeige
AW: Teile eines Eintrages vergleichen
06.02.2020 10:27:23
Tim
Hallo ihr Beiden,
Lutz seine Variante wäre mir am liebsten gewesen, da sie mit wenig Aufwand verbunden wäre jedoch sucht er weiterhin den kompletten Wert statt die ersten drei Zeichen.
@Piet deinen Code habe ich mit meinem Wissen wie folgt angepasst, jedoch bringt er kein Ergebnis:
Sub Test()
Dim WbQ As Workbook, WbZ As Workbook, WsQ As Worksheet, wksQ As Worksheet, wksM As  _
Worksheet
Dim WsZ As Worksheet, tQ As ListObject, Pfad$
Dim i As Long, letzte As Long, Speicher As String, ImportListe As Long, j As Long, letzte_2  _
As Long
Dim a As Variant, x As Variant
Set WbQ = Workbooks.Open(Pfad)
Set WsQ = WbQ.Worksheets(1)
Set WbZ = Workbooks.Add(template:=xlWBATWorksheet)
Set WsZ = WbZ.Worksheets(1)
Set wksQ = GetObject("O:\Test\Test.xlsx").Worksheets("8263")
letzte = WsQ.Cells(WsQ.Rows.Count, 1).End(xlUp).Row
letzte_2 = wksQ.Cells(WsQ.Rows.Count, 1).End(xlUp).Row
ImportListe = WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Row
a = 2  '1.Zeile
For i = 2 To letzte ' ab Zeile 2
x = a  'a retten
For j = a To letzte_2 + 1
If Left(WsQ.Cells(i, 2), 3) = wksQ.Cells(j, 5) Then
WsQ.Cells(i, 3).Value = wksQ.Cells(a, 4).Value
a = j: Exit For
End If
Next j
If a > letzte_2 Then a = x
Next
End Sub

Anzeige
AW: Teile eines Eintrages vergleichen
06.02.2020 11:39:16
Werner
Hallo,
Piet:
If Left(WsQ.Cells(i, 2), 3) = Left(wksQ.Cells(j, 2), 3) Then

Du:
If Left(WsQ.Cells(i, 2), 3) = wksQ.Cells(j, 5) Then
Du vergleichst die ersten 3 Zeichen aus WsQ.Cells(i, 2) mit dem kompletten Wert aus wksQ.Cells(j, 5) und nicht nur mit den ersten 3 Zeichen.
Das würde ja nur dann zutreffen, wenn in wksQ.Cells(j, 5) nur diese ersten 3 Zeichen vorhanden wären.
Gruß Werner

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige