Sub ListenabgleichHyperlink()
'03.11.2008, NoNet - www.excelei.de (z.Zt. down !)
Dim lngZeile As Long, rngZelel As Range
Dim wsListe1 As Worksheet, wsListe2 As Worksheet, wsListe3 As Worksheet
Set wsListe1 = Sheets("Liste1") 'Name bitte anpassen
Set wsListe2 = Sheets("Liste2") 'Name bitte anpassen
Set wsListe3 = Sheets("Liste3") 'Name bitte anpassen
wsListe3.[A:A].ClearContents
wsListe3.[A1] = "Fehlende Werte in Liste1 :"
For lngZeile = 2 To wsListe1.Cells(Rows.Count, 1).End(xlUp).Row
If Application.CountIf(wsListe2.[A:A], wsListe1.Cells(lngZeile, 1)) = 0 Then
Set rngZelle = wsListe3.Cells(wsListe3.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
rngZelle.Value = wsListe1.Cells(lngZeile, 1)
wsListe3.Hyperlinks.Add rngZelle, "#'" & wsListe1.Name & "'!" & _
wsListe1.Cells(lngZeile, 1).Address
End If
Next
'speicher für Objektvariablen in umgekehrter Reihenfolge wieder freigeben
Set rngZelle = Nothing
Set wsListe3 = Nothing
Set wsListe2 = Nothing
Set wsListe1 = Nothing
End Sub
Gruß, NoNet
Hallo Petra,
muss es denn VBA sein?
Die Info kannst du auch direkt per Formel in Tabelle1 erzeugen:
| | A | B | | 1 | MatNr | Hinweis | | 2 | 7 | fehlt in Tab2 | | 3 | 12 | | | 4 | 4 | | | 5 | 13 | fehlt in Tab2 | | 6 | 6 | fehlt in Tab2 | | 7 | 2 | | | 8 | 5 | fehlt in Tab2 | | 9 | 16 | fehlt in Tab2 | | 10 | 11 | | | Formeln der Tabelle | | Zelle | Formel | | B2 | =WENN(ISTZAHL(VERGLEICH(A2;Tabelle2!A:A;0)); "";"fehlt in Tab2") | | B3 | =WENN(ISTZAHL(VERGLEICH(A3;Tabelle2!A:A;0)); "";"fehlt in Tab2") |
|
Und wenn's denn VBA sein muss, ein Tipp: Such mal hier im Archiv nach Application.Match
(Das ist in Excel die Funktion VERGLEICH.)
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
AW: Sverweis per VBA?
fcs
Hallo Petra,
hier mal ein Ansatz.
Gruß
Franz
Sub Listenvergleich()
Dim wb1 As Workbook
Dim wks1 As Worksheet, wks2 As Worksheet, wksHyper As Worksheet
Dim varSuchen, rngGefunden As Range
Dim lngZeile1 As Long, lngZeileHyper As Long
Const SpMatNr1 As Long = 1 'Spalte mit der Materialnummer in Liste 1
Const SpMatNr2 As Long = 1 'Spalte mit der Materialnummer in Liste 2
Set wb1 = ActiveWorkbook 'Datei mit der Liste 1
Set wks1 = wb1.Worksheets("Liste 1")
Set wks2 = ActiveWorkbook.Worksheets("Liste 2")
'Alternative, wenn Liste 2 in anderer Datei
' Set wks2 = Workbooks("DateiListe2.xls").Worksheets("Liste 2")
With wks1
'Materialnummern ab Zeile 1 in Liste 1 in Liste 2 suchen
For lngZeile1 = 1 To .Cells(.Rows.Count, SpMatNr1).End(xlUp).Row
varSuchen = .Cells(lngZeile1, SpMatNr1).Value
Set rngGefunden = wks2.Columns(SpMatNr2).Find(what:=varSuchen, LookIn:=xlValues, _
lookat:=xlWhole)
If rngGefunden Is Nothing Then
'ggf. Tabellenblatt für die Hyperlinks einfügen
If wksHyper Is Nothing Then
wb1.Worksheets.Add Before:=wb1.Sheets(1)
Set wksHyper = ActiveSheet
lngZeileHyper = 2 'Zeile ab der die Hyperlinks eingetragen werden sollen
End If
'Hyperlink auf fehlende Materialnummer erstellen
With wksHyper
.Hyperlinks.Add Anchor:=.Cells(lngZeileHyper, 1), Address:=wb1.FullName, _
SubAddress:="'" & wks1.Name & "'!" & .Cells(lngZeile1, SpMatNr1).Address
.Cells(lngZeileHyper, SpMatNr1).Value = varSuchen
End With
lngZeileHyper = lngZeileHyper + 1
End If
Next
If wksHyper Is Nothing Then
MsgBox "Alle Artikel aus Liste 1 sind Liste 2 enthalten."
End If
End With
End Sub
geht auch mit Formel
Beverly
Hi Petra,
mit einer Hilfsspalte (z.B. Spalte A) in Tabelle3 und dieser Formel:
=WENN(ISTFEHLER(VERGLEICH(Tabelle2!A1;Tabelle1!A$1:A$3000;0));ADRESSE(ZEILE();1;4);"")
und einer weiteren Spalte für die lückenlose Auflistung mit Hyperlink mit dieser Formel
{=HYPERLINK("#Tabelle2!"&WENN(ZEILE(A1)>ANZAHL2(A:A);"";INDEX(A:A;KKLEINSTE(WENN(A$1:A$3000""; ZEILE($1:$1000));ZEILE(A1))));INDIREKT("Tabelle2!"&INDEX(A:A;KKLEINSTE(WENN(A$1:A$3000""; ZEILE($1:$3000));ZEILE(A1))))) }.
Spalte A kannst du ausblenden.
Formelursprung für lückenloses Auflisten: http://www.excelformeln.de/formeln.html?welcher=43
____________________
Danke an David, Nonet, Erich, fcs und Beverly,
ich muß erst mal alle Lösungsansätze durcharbeiten (muß VBA sein). Sollte ich noch weitere Fagen haben, darf ich mich nochmals an Euch wenden?!
Liebe Grüße
Petra
|