|
Hallo
wie der Kollege schon sagte, es fehlen konkrete Angaben um die Aufgabe Optimal zu lösen. Zum Glück gibt es die Const Anweisungen!
In den Constant Zeilen musst du die Spalten angeben, die in deiner Basisliste und Liste wirklich vorhanden sind. Dann klappt das Makro.
mfg Nobody
Option Explicit
Const BasLfSpa = "B" 'Lieferanten Spalte in Basisliste!!
Const BasBgSpa = "C" 'Belege Spalte in Basisliste
Const LstLfSpa = "B" 'Lieferanten Spalte in LISTE (Zieltabelle)
Const LstBgSpa = "C" 'Belege Spalte in LISTE
Sub Lieferanten_vergleichen()
Dim AC As Range, n As Long
Dim zList As Long, j As Long
Dim LfID As Variant, lz1 As Long
Dim Adr1 As String, rFind As Range
Dim List As Worksheet, Txt As String
Set List = Worksheets("Liste")
With Worksheets("Basisliste")
'LastZell in Spalte A suchen (von unten)
lz1 = List.Cells(Rows.Count, 2).End(xlUp).Row * 1
List.Range("A2:K" & lz1).ClearContents
Application.ScreenUpdating = False
'LastZell in Spalte A suchen (von unten)
lz1 = .Cells(Rows.Count, 2).End(xlUp).Row
zList = 2: n = 0 '1.Zeile in Liste
For Each AC In .Range(BasLfSpa & 2 & ":" & BasLfSpa & lz1)
LfID = AC.Value 'Lieferanten Nummer aus Nasisliste
If InStr(Txt, LfID) Then GoTo nx 'bereits vorhanden?
If AC.Value = Empty Then GoTo nx 'Leere Zellen überspringen
Txt = Txt & ", " & LfID 'Lieferanten in Txt Variable merken
Set rFind = .Columns(BasLfSpa).Find(What:=AC, After:=.Cells(1, BasLfSpa), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then
Adr1 = rFind.Address 'Lieferant in Liste notieren
List.Cells(zList, LstLfSpa) = .Cells(AC.Row, BasLfSpa)
Do 'Alle Beleger in Liste notieren
List.Cells(zList, LstBgSpa) = .Cells(rFind.Row, BasBgSpa)
zList = zList + 1: n = n + 1
Set rFind = .Columns(BasLfSpa).FindNext(rFind)
Loop Until Adr1 = rFind.Address
nx: End If
Next AC
Application.ScreenUpdating = True
MsgBox n & " Belege aufgelistet"
End With
End Sud
|