sVerweis: unterschiedliche Ranges und Quellen
#1
Hallo liebes Forum

Ich wäre um eure Hilfe sehr dankbar!

Mit untenstehendem Code suche ich jeden Wert im Sheet (shtLV_Import, Spalte Q) und schaue, ob dieser Wert in einem importierten Katalog (Spalte F) vorhanden ist.
Wenn ja, wird der dann in Spalte H befindliche Wert zurück in mein importiertes Sheet geschrieben.

Aber...

Ich muss diesen Code nun dahingehend abhändern, dass ich als Schleife für VERSCHIEDENE Bereiche des shtLV_Import auch VERSCHIEDENE Kataloge verwenden muss.

Beispiel:
Zeile 1 - 200              --> Katalog1
Zeile 201 - 500          --> Katalog2
Zeile 501 bis lastrow  --> Katalog3

Die Bereiche bzw. Zeilen ändern sich natürlich je nach erhaltener Datei, ich werde diese aber händisch über eine Userform eintragen, ebenso den Katalog der jeweiligen Bereiche. Gelegentlich gibt es nur einen Bereich bzw. das ganze Sheet, gelegentlich 2-3 Bereiche mit eigenen Such-Katalogen.

Aber ich habe im moment keinen Ansatz, wie ich die Schleife einbauen muss... Sad

Hat jemand von euch eine Idee?

Danke im Voraus und schöne Grüsse

Christian

Code:
Sub G_Flexibler_Sverweis()
Dim i As Long, letzteZeileKatalog As Long, lngFirstRow As Long
Dim strGefunden As String
Dim Suchwert As String
Dim shtKatalog As Worksheet
Dim shtLV_Import As Worksheet
Dim ZelleGefunden As Range
Dim Suchbereich As Range

Set shtKatalog = ThisWorkbook.Worksheets("Katalog") 'Kopie Katalog
Set shtLV_Import = ThisWorkbook.Worksheets("LV_Import")

'Suchbereich im import. Katalog festlegen
letzteZeileKatalog = shtKatalog.Range("C" & Rows.Count).End(xlUp).Row
Set Suchbereich = shtKatalog.Range("C3:C" & letzteZeileKatalog)

'SCHLEIFE:
For i = lngFirstRow To shtLV_Import.Range("Q" & Rows.Count).End(xlUp).Row

        'PRÜFEN OB WERT IN Q VORHANDEN:
        If shtLV_Import.Cells(i, 17).Value <> "" Then
            Suchwert = shtLV_Import.Range("Q" & i).Value 'Suchwert=Positionsnummer in Spalte 17 - Sheet LV_Import
             
            With shtKatalog
                Set ZelleGefunden = Suchbereich.Find(Suchwert, LookIn:=xlValues, LookAt:=xlWhole)
                    'NICHT GEFUNDEN
                    If ZelleGefunden Is Nothing Then
                           strGefunden = ""
                           With shtLV_Import
                           .Range("H" & i).Value = "Kein Wert"
                           .Range("H" & i).Font.Color = vbRed 'Rot
                           'Aussen:
                           .Range("R" & i).Value = "Kein Wert"
                           End With
                           
                    'GEFUNDEN
                    Else
                        'Gefundener Wert:
                        strGefunden = CDbl(.Range("F" & ZelleGefunden.Row).Value) 'Wert in Spalte F (F = Katalogpreise) der gefundenen (Katalog)Zeile
                        'In LV übertragen:
                        With shtLV_Import
                            .Range("H" & i).Value = strGefunden
                            .Range("H" & i).Font.Color = vbBlue 'Blau
                            .Cells(i, 9).Font.Color = vbBlue 'Blau
                            If IsError(Cells(i, 9)) Then Cells(i, 9).Value = ""
                        End With

                    Set ZelleGefunden = Nothing
                    End If
            End With
End Sub
Top
#2
Hallöchen,

auf den ersten Blick fehlt in Deiner Schleife unten das Next. Wenn Du schon mit dem Makro schon gearbeitet hast, hast Du das bestimmt bei Deinen Änderungsversuchen irgendwie entfernt.

Du brauchst doch nur am Anfang der Schleife in Abhängigkeit von der Zeilennummer - also dem Schleifenzähler - den Bereich definieren und dann erst das Blatt und den Suchbereich setzen. Im Prinzip

For i=...
if i<201 then strKat="katalog1" elseif i<501 then strKat="katalog2" else strkat="katalog3"
Set shtKatalog = ThisWorkbook.Worksheets(strKat)
'Suchbereich im import. Katalog festlegen
letzteZeileKatalog = shtKatalog.Range("C" & Rows.Count).End(xlUp).Row
Set Suchbereich = shtKatalog.Range("C3:C" & letzteZeileKatalog)
...
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste