Range bepalen op andere sheet + toepassen op VlookUp in VBA

[Chris4VBA]

Hoi, zit met volgende (beginners) probleem:

In mijn Excell blad "Sheet1" sta ik geselecteerd op cel A1. In "Developer" > "Visual Basic" schrijf ik een code neer om eerst een "Range" te selecteren in mijn huidige sheet1. Vervolgens schrijf ik een code om vanuit sheet1 een range te selecteren in Sheet2. Het is deze tweede lijn/code waar ik steeds een foutboodschap krijg. Heb al gepoogd om er "worksheet" voor te plaatsen, de naam van het workbook > telkens foutboodschap. Wat moet ik doen om een Range te selecteren uit sheet 2 vanuit sheet1? De bedoeling is niet dat ik eerst de sheet selecteer in 1 lijn en vervolgens de range in een aparte lijn. Ik wil namelijk in 1 lijn de range bepalen.

Hieronder de code:

Sub Test()

Range("B2:D5").Select

Sheets(Sheet2).Range("D6:G12").Select


End Sub

De bedoeling is om te komen tot volgende:

Ik wil namelijk VlookUp toepassen in mijn VBA-code waarbij de lijst waarin moet gezocht worden zich op een andere locatie bevind (sheet 2). Als ik mijn formule toepas met een range die zich in dezelfde sheet bevindt als mijn te zoeken element, lukt het (in dit geval gebruik ik "Set n = Range("N:Q") + formule ActiveCell.Value = Application.WorksheetFunction.VLookup(v, n, 2, False) ". Wanneer ik een range wil gebruiken op een andere sheet weigert VBA de code te aanvaarden (in dit voorbeeld gebruik ik "Set y = Sheets("Sheet2").Range("A")" + formule ActiveCell.Value = Application.WorksheetFunction.VLookup(v, y, 2, False). (Ter info: in mijn bijlage en hieronder heb ik deze lijn desactiveerd via ' om de foutboodschappen te vermijden).

Sub VlookUp_for_VBA()


Dim r As Range
Dim n As Range
Dim v As Range
Dim y As Range

Dim i As Long
Dim t As Long

Set r = Range("A:A")
Set n = Range("N:Q")
'Set y = Sheets("Sheet2").Range("A:D")


i = WorksheetFunction.CountA(r)

Range("B1").Select


Do Until t = i - 1
        
    ActiveCell.Offset(1, 0).Select
    
    Set v = ActiveCell.Offset(0, -1)
    
        If IsEmpty(v) Then
    
            ActiveCell.Offset(0, 0).Select
    
        Else

            ActiveCell.Value = Application.WorksheetFunction.VLookup(v, n, 2, False)
      
            t = t + 1
        
        End If
        
Loop

End Sub

Hopelijk is het enigszins duidelijk...

Alvast bedankt voor de hulp

 

[JEC.]

Selects heb je binnen VBA niet nodig en ze maken je code traag. Gebruik liever niet de "worksheetfunctions".

Sub jec()
 Dim ar, a As Variant, i As Long
 ar = Sheets(1).Range("A1", Sheets(1).Cells(Rows.Count, 1).End(xlUp)).Resize(, 2)
 
 With Sheets(2).UsedRange
   For i = 2 To UBound(ar)
     a = Application.Match(ar(i, 1), .Columns(1), 0)
     If IsNumeric(a) Then ar(i, 2) = Application.Index(.Columns(2), a, 0)
   Next
 End With
 
 Sheets(1).Range("A1", Sheets(1).Cells(Rows.Count, 1).End(xlUp)).Resize(, 2) = ar
End Sub

Hiervoor is VBA niet nodig, met VLookup binnen Excel gaat het veel makkelijker.

 

[HSV]

Alternatief zonder loop.

Sub hsv()
Dim sv, x
With Application
   sv = .Transpose(Sheets(2).Range("a1", Sheets(2).Cells(Rows.Count, 2).End(xlUp).Offset(1)))
   x = .Transpose(Sheets(1).Range("a2", Sheets(1).Cells(Rows.Count, 1).End(xlUp)))
   sv = .Index(sv, 2, .IfError(.Match(x, .Index(sv, 1), 0), UBound(sv, 2)))
 Sheets(1).Cells(2, 2).Resize(UBound(sv)) = .Transpose(sv)
End With
End Sub

Of iets korter.

Sub hsv()
Dim sv, x
With Application
   sv = Sheets(2).Range("a1", Sheets(2).Cells(Rows.Count, 2).End(xlUp).Offset(1))
   x = Sheets(1).Range("a2", Sheets(1).Cells(Rows.Count, 1).End(xlUp))
   sv = .Index(sv, .IfError(.Match(x, .Index(sv, 0, 1), 0), UBound(sv)), 2)
 Sheets(1).Cells(2, 2).Resize(UBound(sv)) = sv
End With
End Sub

 

[JEC.]

Nog een optie zonder loop

Sub jec()
Set jv = Sheets(2).Range("a1", Sheets(2).Cells(Rows.Count, 2).End(xlUp))
 With Sheets(1).Range("a2", Sheets(1).Cells(Rows.Count, 1).End(xlUp))
  .Offset(, 1).Value = Evaluate(Replace(Replace(Replace("iferror(lookup(##,Sheet2!@@,Sheet2!%%),"""")", "##", .Address), "@@", jv.Columns(1).Address), "%%", jv.Columns(2).Address))
 End With
End Sub

 

[HSV]

Ik vind hem keurig gevonden. :thumb:

Alternatief:

.Offset(, 1).Value = Evaluate("iferror(lookup(" & .Address & ",sheet2!" & jv.Columns(1).Address & ",sheet2!" & jv.Columns(2).Address & "),"""")")

Of iets robuuster.

.Offset(, 1).Value = Evaluate("iferror(lookup(sheet1!" & .Address & ",sheet2!" & jv.Columns(1).Address & ",sheet2!" & jv.Columns(2).Address & "),"""")")

Kan mooi als de getallen zoals hier oplopend zijn in de LookUp.

 

[JEC.]

Thanks! Mooie aanvulling ook. Gebruik die methode steeds vaker, lekker kort:thumb: