Microsoft Excel

Herbers Excel/VBA-Archiv

vlookup 2 Spalten | Herbers Excel-Forum


Betrifft: vlookup 2 Spalten von: Kai
Geschrieben am: 16.02.2012 10:47:02

Hallo zusammen,
ich habe unten stehenden Code der auch macht was er soll :-)

Das Problem ist nur, das er nur Spalte A von Datei A mit Spalte A von Datei B vergleicht.
Das führt zu Fehlern. Um die Fehler zu vermeiden müssten 2 Spalten verglichen werden.
Korrekter Vergleich: Wenn Spalte A von Datei A mit Spalte A von Datei B und Spalte F von Datei A mit Spalte F von Datei B identisch sind, dann sollen die entsprechenden Werte aus den Zeilen kopiert werden.

Hab es leider nicht hingefrikelt bekommen.

Public Sub vlookup()
 Dim strDatName As Variant
 Dim wbA As Workbook, wbB As Workbook
 Dim wsA As Worksheet, wsB As Worksheet
 Dim iZeile As Long, letzteZeile As Long
 Dim Suchnummer
    
 
 Worksheets("Jan.").Unprotect Password:=""
 getMoreSpeed True
 ' Dateinnamen definieren
 strDatName = Application.GetOpenFilename("ExcelFiles (*.XLS), *.xls")
  
 If strDatName <> False Then
     Set wbB = Workbooks.Open(strDatName)
     Set wbA = ThisWorkbook
 Else
     Exit Sub
 End If
 
 ' Tabellennamen definieren
 Set wsA = wbA.Worksheets(2)
 Set wsB = wbB.Worksheets(2)
 
 ' Suche
 For iZeile = 5 To wsA.Range("A65536").End(xlUp).Row
     Suchnummer = wsA.Cells(iZeile, 1)
         letzteZeile = wsB.Range("A65536").End(xlUp).Row
         If WorksheetFunction.CountIf(wsB.Range("A5:A" & letzteZeile), Suchnummer) > 0 Then
             wsA.Cells(iZeile, 8) = WorksheetFunction.vlookup(Suchnummer, wsB.Range("A4:H" & _
 letzteZeile), 8, False)
             wsA.Cells(iZeile, 9) = WorksheetFunction.vlookup(Suchnummer, wsB.Range("A4:I" & _
 letzteZeile), 9, False)
        End If
      Next iZeile
 
 ' Datei B schliessen
 wbB.Close
 
 getMoreSpeed False
 Worksheets("Jan.").Protect Password:=""

 End Sub
Bin für Anregungen dankbar!

Gruß

Kai

  

Betrifft: AW: vlookup 2 Spalten von: fcs
Geschrieben am: 16.02.2012 14:14:26

Hallo Kai,

sollte etwa so funktionieren:

Public Sub vlookupZwei()
  Dim strDatName As Variant
  Dim wbA As Workbook, wbB As Workbook
  Dim wsA As Worksheet, wsB As Worksheet
  Dim iZeile As Long, letzteZeile As Long
  Dim Suchnummer, varSuch2, boolTreffer As Boolean
  Dim rngB As Range, rngFinden As Range, sErsteZelle As String
     
  
  Worksheets("Jan.").Unprotect Password:=""
  getMoreSpeed True
  ' Dateinnamen definieren
  strDatName = Application.GetOpenFilename("ExcelFiles (*.XLS), *.xls")
   
  If strDatName <> False Then
      Set wbB = Workbooks.Open(strDatName)
      Set wbA = ThisWorkbook
  Else
      Exit Sub
  End If
  
  ' Tabellennamen definieren
  Set wsA = wbA.Worksheets(2)
  Set wsB = wbB.Worksheets(2)
  letzteZeile = wsB.Range("A65536").End(xlUp).Row
  With wsB
   'zu durchsuchender Bereich in Blatt B fur Suchnummer
     Set rngB = .Range(.Cells(5, 1), .Cells(letzteZeile, 1))
  End With
  ' Suche
  For iZeile = 5 To wsA.Range("A65536").End(xlUp).Row
      Suchnummer = wsA.Cells(iZeile, 1)
      varSuch2 = wsA.Cells(iZeile, 6).Value
      'Suchnummer in B suchen
      Set rngFinden = rngB.Find(What:=Suchnummer, LookIn:=xlValues, lookat:=xlWhole)
      boolTreffer = False
      If Not rngFinden Is Nothing Then
         'Zelladresse der 1. Fundstelle merken
         sErsteZelle = rngFinden.Address
         Do
           'Wert in Spalte F mit 2. Suchwert vergleichen
           If wsB.Cells(rngFinden.Row, 6).Value = varSuch2 Then
              boolTreffer = True
              Exit Do
           End If
           'Suche in Spalte A wiederholen
           Set rngFinden = rngB.FindNext(After:=rngFinden)
         Loop Until rngFinden.Address = sErsteZelle
       End If
       If boolTreffer = True Then
          wsA.Cells(iZeile, 8) = wsB.Cells(rngFinden.Row, 8)
          wsA.Cells(iZeile, 9) = wsB.Cells(rngFinden.Row, 9)
        Else
          wsA.Cells(iZeile, 8).ClearContents
          wsA.Cells(iZeile, 9).ClearContents
        End If
   Next iZeile
  
  ' Datei B schliessen
  wbB.Close
  
  getMoreSpeed False
  Worksheets("Jan.").Protect Password:=""
  
End Sub

Gruß
Franz


  

Betrifft: AW: vlookup 2 Spalten von: Kai
Geschrieben am: 16.02.2012 15:27:39

Hallo Franz,
herzlichen Dank!

Ich musste diesen Teil löschen, da ich manche Inhalte aus den Zellen noch brauche:

        Else
          wsA.Cells(iZeile, 8).ClearContents
          wsA.Cells(iZeile, 9).ClearContents
        End If
Aber der Rest funktioniert perfekt bzw. alles funktioniert perfekt nur musste es für mich noch angepasst werden.

Danke dafür!

Gruß

Kai


Beiträge aus den Excel-Beispielen zum Thema "vlookup 2 Spalten"