Home VBA Makro Beispiele Schleifen VBA - Do Loop Schleife
VBA - Do Loop Schleife PDF Drucken E-Mail
Geschrieben von: Marcus Rose   
Sonntag, 02. Oktober 2011 um 17:05 Uhr

Wir wollen in einer Spalte nach Übereinstimmungen suchen. In diesem Beispiel nutzen wir die Do Loop Schleife, damit wir auch mehrere Übereinstimmungen ausfindig machen können. Ich habe euch diese kleine Beispieltabelle erstellt:

A B C
1 Suche nach: Name 1
2 Name 4 Name 2
3 Name 3
4 Name 4 gesuchter Eintrag
5 Name 5
6 Name 1
7 Name 2
8 Name 3
9 Name 4 gesuchter Eintrag
10 Name 5
11 Name 1
12 Name 2
13 Name 3
14 Name 4 gesuchter Eintrag
15 Name 5
16 Name 1
17 Name 2
18 Name 3
19 Name 4 gesuchter Eintrag
20 Name 5

 

In Zelle A2 steht der Suchbegriff. Nun soll in Spalte B, bis eine leere Zelle kommt, die Suche nach dem Suchbegriff erfolgen. Hinter dem gefundenen Eintrag soll nun in Spalte C der Text: "gefundener Eintrag" stehen. Dazu gehört dieses kleine Makro.

Sub Treffer_Do_Loop1()
'Eintrag mittels Zelle (A1) suchen
    Dim anZahl As Integer
    Dim Text As String
    Dim bolgef As Boolean
    Columns(3).ClearContents
    bolgef = False
    Text = "gesuchter Eintrag"
    anZahl = 1
    Do While Cells(anZahl, 2) <> ""
        If Cells(anZahl, 2) = Range("A2").Value Then
            Cells(anZahl, 3) = Text
            bolgef = True
        End If
        anZahl = anZahl + 1
    Loop
    If bolgef = False Then MsgBox "Keine Übereinstimmung gefunden!"
End Sub

 

Natürlich können wir auch eine Abfrage mittels einer Inputbox machen. Dann benötigen wir nicht den Eintrag in Zelle A2!


Sub Treffer_Do_Loop2()
'Eintrag mittels Inputbox suchen
    Dim anZahl As Integer
    Dim strFrage As Variant
    Dim Text As String
    Dim bolgef As Boolean
    Columns(3).ClearContents
    strFrage = Application.InputBox("Wonach soll gesucht werden?" & Chr(13) _
    & "Achten Sie auf Gross- und Kleinschreibung", "Suche nach", Type:=3)
    If strFrage = 0 Then
        MsgBox "Eingabe wurde abgebrochen."
    Else
        bolgef = False
        'Text soll hinter der Fundstelle stehen
        Text = "gesuchter Eintrag"
        anZahl = 1
        Do While Cells(anZahl, 2) <> ""
            If Cells(anZahl, 2) = strFrage Then
                Cells(anZahl, 3) = Text
                bolgef = True
            End If
            anZahl = anZahl + 1
        Loop
        If bolgef = False Then MsgBox "Keine Übereinstimmung gefunden!"
    End If
End Sub
 
Copyright © 2017 ms-excel.eu. Alle Rechte vorbehalten.
 

Autoren - Login

Werbung

wichtige Links:
http://ms-excel.eu
Hier habt Ihr eine gute Excel Hilfe
Besucherstatistik
Besucher gesamt: 4.476.129
Besucher heute: 1.576
Besucher gestern: 1.981
Max. Besucher pro Tag: 4.488
gerade online: 16
max. online: 507
counter Statistiken