Hilfe bei Schleife
#1
Hallo!

Wäre jemand so nett und würde mir über meinen Code eine Schleife basteln, dass die Variable "feld" und die Variable "ausgabe" jeweils gleichzeitig immer wieder um 1 erhöht bis das ganze 20 mal durchgespielt wurde.
Die "auswahl" soll gleich bleiben.

Sprich ich hab 20 Werte untereinander (F15-F35) die ich mit wverweis in der "auswahl" vergleiche und diese ganzen verglichenen Werte (F15-F35), sollen mir beginnend mit der zelle "ausgabe" nach unten aufgelistet werden (K40-K60).


Code:
Sub wverweis()

' wverweis Makro

Dim rückgabe
Dim auswahl, feld, ausgabe As Range
Dim i As Integer
 
Set feld = Range("F15")
Set ausgabe = Range("K40")


Set auswahl = Rows(11).Find(what:="tofind", LookIn:=xlValues, lookat:=xlWhole)
 
  If Not auswahl Is Nothing Then
 
      Range(Cells(11, 8), auswahl.Offset(0, -1)).Select
          rückgabe = Application.WorksheetFunction.HLookup(feld, Selection, 1, True)
          If rückgabe = feld.Value Then ausgabe = "" Else: ausgabe = feld
         
      ausgabe.Select
           
     
  Else
      MsgBox "TOFIND fehlt am Ende des Bereichfeldes"
  End If
   

End Sub

Könnte mir das jemand direkt in den Code einbauen? Bin leider ein Anfänger was VBA angeht <.>


Vielen Dank für Eure Hilfe!!

LG Kash
Top
#2
Hallo,

meinst Du so?
Code:
Sub wverweis()

' wverweis Makro

Dim lngC As Long
Dim rückgabe
Dim auswahl As Range, feld As Range, ausgabe As Range
Dim i As Integer
  
  
For lngC = 15 To 35

'Set feld = Range("F15")
'Set ausgabe = Range("K40")
Set feld = Range("F" & lngC)
Set ausgabe = Range("K" & lngC + 25)


Set auswahl = Rows(11).Find(what:="tofind", LookIn:=xlValues, lookat:=xlWhole)
  
   If Not auswahl Is Nothing Then
  
       Range(Cells(11, 8), auswahl.Offset(0, -1)).Select
           rückgabe = Application.WorksheetFunction.HLookup(feld, Selection, 1, True)
           If rückgabe = feld.Value Then ausgabe = "" Else: ausgabe = feld
          
       ausgabe.Select
            
      
   Else
       MsgBox "TOFIND fehlt am Ende des Bereichfeldes"
   End If
    
Next lngC
End Sub
Gruß Stefan
Win 10 / Office 2016
[-] Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:
  • Kash
Top
#3
Perfekt! Genau was ich meinte!

Vielen Dank!!

LG
Top


Gehe zu:


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