Hyperlink Makro
17.04.2021 23:34:31
Roger
Ich habe in Spalte "A" Artikelnummern, diese möchte ich mit den Artikelnummern aus Spalte "D" vergleichen. In der Spalte "E" stehen die Lagerbestände für die Artikel in "D".
Wenn jetzt der Wert von "A5" mit einem Wert aus der Spalte "D" übereinstimmt, hätte ich gerne den Lagerbestand aus der Zelle ("E"), der neben der gefundenen Zelle aus "D" steht, kopiert in die Spalte "B5".
Vielleicht so besser verständlich:
Vergleiche "A" mit "D"| Wenn "A4" = "D4" -> kopiere Wert aus "E4" nach "B4"| Wenn "A4" ungleich "D4" springe eine Zelle in "D" nach unten (bis zum Ende).
Das gleiche dann mit "A5".
Das oben beschriebene klappt mit dem Makro super nur mit dem Link hapert es noch (Zusätzlich möchte ich beim kopieren von "E4" (Link) das der Link auch in "B4" übernommen wird. Wie muss ich das Makro anpassen damit es mit dem kopieren des Links klappt?
Viele Grüsse
Roger
Option Explicit
Sub Bestandabfragen()
Dim WSq As Worksheet
Dim WSz As Worksheet
Dim BestArtCol As Range
Dim BestCol As Range
Dim ArtCol As Range
Dim ZielCol As Range
Dim HelpArr As Variant
Dim Dict As Object
Dim Zeile As Long
'Anpassen------------------------------------------------------------------
Set WSz = Worksheets("Tabelle1") 'Zielworksheet
Set WSq = Worksheets("Tabelle1") 'Quellworksheet
Set ArtCol = WSz.Columns("A") 'Spalte, in der die kurze Artikelliste steht
Set ZielCol = WSz.Columns("B") 'Spalte für die Bestände der kurzen Artikelliste
Set BestArtCol = WSq.Columns("D") 'Spalte, in der die lange Artikelliste steht
Set BestCol = WSq.Columns("E") 'Spalte für die Bestände der langen Artikelliste
'Anpassen------------------------------------------------------------------
Set Dict = CreateObject("Scripting.Dictionary")
'Artikel und Bestände einlesen
HelpArr = Intersect(Union(BestArtCol, BestCol), WSq.UsedRange)
For Zeile = 1 To UBound(HelpArr, 1)
Dict(HelpArr(Zeile, 1)) = HelpArr(Zeile, 2)
Next
'Kurze Artikelliste einlesen und Bestände zuordnen
With WSz
HelpArr = Range(.Cells(1, ArtCol.Column), .Cells(.Cells(.Rows.Count, ArtCol.Column).End( _
xlUp).Row, ArtCol.Column))
End With
For Zeile = 1 To UBound(HelpArr, 1)
HelpArr(Zeile, 1) = Dict(HelpArr(Zeile, 1))
Next
'Ausgabe der Bestände
ZielCol.ClearContents
WSz.Cells(1, ZielCol.Column).Resize(UBound(HelpArr, 1)) = HelpArr
End Sub
