Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Bezug suchen in Makro verwenden

Betrifft: Bezug suchen in Makro verwenden von: Jimmy
Geschrieben am: 09.10.2020 20:30:45

Hallo ich möchte gern ein Makro anpassen, leider habe ich keine Ahnung wie es abgeändert werden muss.

Ich Möchte den Namen aus einer Zeile auslesen, per Makro, und diesen mit dem untenstehenden verbinden.

Ziel ist es:

Sheets("Tabelle").Cells(j, 1) zu ändern. Bedeutet, ich suche nach dem Wort "Hund" in der Zeile 1 (mit 15 Spalten) und die Zelle in der das Wort steht soll in Sheets("Tabelle").Cells(j, 1) stehen. Ich möchte somit die Spalten variabler gestalten können ohne die Bezugszelle immer wieder um zu schreiben. Da ich 15 Spalten habe, denke ich, dass eine Schleife notwendig ist. Ich habe selbst nicht sehr viel Ahnung von VBA, deswegen ist mein Verständnis von manchen Dingen wie DIM und IF nicht sehr hoch. Danke für jeden der mir helfen kann.


Sub alle_Arbeitsblätter()
Dim i, j, k As Integer
j = 2
    k = 20
    Worksheets(i).Activate
    If Not (IsEmpty(Cells(6, 1))) Then
      If Left(Sheets(i).Name, 6) <> "Start" And Left(Sheets(i).Name, 5) <> "Liste" Then
        Sheets(i).Name = Cells(6, 1)
        While Not (IsEmpty(Cells(k, 1)))
         
         Sheets("Tabelle").Cells(j, 1) = j - 1
         Sheets("Tabelle").Cells(j, 2) = Cells(6, 1)
         Sheets("Tabelle").Cells(j, 3) = Cells(8, 6)
         Sheets("Tabelle").Cells(j, 4) = Cells(6, 9)
         Sheets("Tabelle").Cells(j, 5) = Cells(k, 1)
    
        k = k + 1
        j = j + 1
        Wend
      End If
    End If
      Next i
        Sheets("Tabelle").Cells(j + 1, 1) = Empty
        Sheets("Tabelle").Cells(j + 2, 1) = Empty
        Sheets("Tabelle").Cells(j + 3, 1) = Empty
        Sheets("Tabelle").Cells(j + 4, 1) = Empty
        Sheets("Tabelle").Cells(j + 5, 1) = Empty
        
End Sub

Betrifft: AW: Bezug suchen in Makro verwenden
von: Werner
Geschrieben am: 09.10.2020 21:37:03

Hallo,
Public Sub aaa()
Dim raFund As Range, loSpalte As Long

Set raFund = Sheets("Tabelle").Rows(1).Find(what:="Hund", LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
    loSpalte = raFund.Column
Else
    MsgBox "Fehler: Der Suchbegriff wurde nicht gefunden."
    Exit Sub
End If

'hier dein weiterer Code
'mit Cells(11,loSpalte) z.B hast du Zugriff auf die gefundene Spalte in Zeile 11

'ganz am Ende des Makros
Set raFund = Nothing
End Sub
Gruß Werner

Betrifft: AW: Bezug suchen in Makro verwenden
von: Jimmy
Geschrieben am: 10.10.2020 16:33:07

Erst einmal vielen lieben Dank für die super Hilfe, dies ist nicht selbst verständlich. Ich habe den Code ausprobiert und bin auf ein Problem gestoßen, welches ich nicht behoben bekomme.

Die Mehrfachabfrage funktioniert super. Probleme gibt es nur, wenn das gesuchte Wort nicht vorhanden ist. Es wird einfach beendet ohne ins nächste zu springen. Ich habe einiges versucht mit Else, aber es springt nicht weiter und beendet den Vorgang.

Dim raFund As Range, loSpalte As Long
Dim raFund1 As Range, loSpalte1 As Long

Set raFund = Sheets("Tabelle1").Rows(1).Find(what:="Katze", LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
    loSpalte = raFund.Column
Else
    
 Set raFund1 = Sheets("Tabelle1").Rows(1).Find(what:="Hund", LookIn:=xlValues, lookat:=xlWhole)
If Not raFund1 Is Nothing Then
loSpalte1 = raFund1.Column
Else

    Exit Sub
End If
End If


Betrifft: AW: Bezug suchen in Makro verwenden
von: Jimmy
Geschrieben am: 10.10.2020 16:49:42

Ps.: "On Error Resume Next" , hatte ich schon probiert, funktioniert aber bei der letzten Abfrage nicht, dort erscheint Laufzeitfehler.

Betrifft: AW: Bezug suchen in Makro verwenden
von: Werner
Geschrieben am: 11.10.2020 05:40:18

Hallo,

was du da jetzt letztlich genau vor hast erschließt sich mir nicht aber
Public Sub Test()
Dim raFund As Range, loSpalte As Long

Set raFund = Sheets("Tabelle1").Rows(1).Find(what:="Katze", LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
    loSpalte = raFund.Column
Else
    Set raFund = Sheets("Tabelle1").Rows(1).Find(what:="Hund", LookIn:=xlValues, lookat:= _
xlWhole)
    If Not raFund Is Nothing Then
        loSpalte = raFund.Column
    End If
End If
End Sub
Gruß Werner

Betrifft: AW: Bezug suchen in Makro verwenden
von: Jimmy
Geschrieben am: 11.10.2020 13:37:46

Danke Werner für deine Hilfe, habe es heute aber selbst anpassen können und schreibe kurz was ich möchte und den Code für andere zur Verfügung stellen.

Das bisherige Makro, hat aus verschiedenen Datenblättern (alle gleich aufgebaut) Informationen zusammengesammelt und in ein extra Tabellenblatt zusammengefasst.
An sich hat der untere Teil des Makros super funktioniert, aber die Spalten sollten Variabel werden, deswegen meine Anfrage. Die andere Bedingung war, das Makro vor zu schreiben mit Leerbefehlen, so das später einfach nur noch die Wörter ins Makro geschrieben werden die gesucht werden. Ziel war es, wenn jemand anderes die Spalten ändert oder den Namen löscht, das Makro dennoch weiterarbeitet.

Es hat bei mir mit Error Resum Next nicht funktioniert da ich "Exit Sub" gar nicht für voll genommen habe. -.-

Vielen Dank noch einmal, dass du mir weiterhelfen konntest, ob es nun Sinn macht Leerbefehle zu erzeugen oder nicht, durfte ich als Frage nicht stellen.
Sub alle_Arbeitsblätter()

Dim i, j, k As Integer
Dim raFund1 As Range, loSpalte1 As Long
Dim raFund2 As Range, loSpalte2 As Long
Dim raFund3 As Range, loSpalte3 As Long
On Error Resume Next

Set raFund1 = Sheets("Tabelle1").Rows(1).Find(what:="Hund", LookIn:=xlValues, lookat:=xlWhole)
If Not raFund1 Is Nothing Then
loSpalte1 = raFund1.Column

Set raFund2 = Sheets("Tabelle1").Rows(1).Find(what:="Katze", LookIn:=xlValues, lookat:=xlWhole)
If Not raFund2 Is Nothing Then
loSpalte2 = raFund2.Column

Set raFund3 = Sheets("Tabelle1").Rows(1).Find(what:="Platzhalter", LookIn:=xlValues, lookat:= _
xlWhole)
If Not raFund3 Is Nothing Then
loSpalte3 = raFund3.Column

    On Error GoTo 0
End If
End If

j = 2
Application.ScreenUpdating = False 'Meyer Bildschirm ausgeschaltet
For i = 1 To Worksheets.Count 'Schleife für Arbeitsblätter
        
    k = 20
    Worksheets(i).Activate
    If Not (IsEmpty(Cells(6, 1))) Then
      If Left(Sheets(i).Name, 6) <> "Start" And Left(Sheets(i).Name, 5) <> "Tabelle1" Then
        Sheets(i).Name = Cells(6, 1)
        While Not (IsEmpty(Cells(k, 1)))
         
         Sheets("Tabelle1").Cells(j, 1) = j - 1
         Sheets("Tabelle1").Cells(j, loSpalte1) = Cells(6, 1)
         Sheets("Tabelle1").Cells(j, loSpalte2) = Cells(8, 6)
         Sheets("Tabelle1").Cells(j, 4) = Cells(6, 9)
         Sheets("Tabelle1").Cells(j, 6) = Cells(k, 1) 
        k = k + 1
        j = j + 1
        Wend
      End If
    End If
      Next i
        Sheets("Tabelle1").Cells(j + 1, 1) = Empty
        Sheets("Tabelle1").Cells(j + 2, 1) = Empty
        Sheets("Tabelle1").Cells(j + 3, 1) = Empty
        Sheets("Tabelle1").Cells(j + 4, 1) = Empty
        Sheets("Tabelle1").Cells(j + 5, 1) = Empty
        
        
    Worksheets(1).Select
    Application.ScreenUpdating = True 'Meyer Bildschirm eingeschaltet
    
Set raFund1 = Nothing
Set raFund2 = Nothing
Set raFund3 = Nothing
End Sub