Schleifendurchlauf festlegen

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

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

Schleifendurchlauf festlegen

Schleifendurchlauf festlegen von Stefanie vom 19.08.2014 10:25:20

Exit For owT - von Rudi Maintaire am 19.08.2014 10:26:56
- ohne schleife? - von Klaus M.vdT. am 19.08.2014 10:45:35
ohne Schleife - von Rudi Maintaire am 19.08.2014 10:45:22
- AW: ohne Schleife - von Stefanie am 19.08.2014 11:18:30
  - AW: ohne Schleife - von Klaus M.vdT. am 19.08.2014 12:32:15
    - AW: ohne Schleife - von Stefanie am 19.08.2014 12:45:01
      - AW: ohne Schleife - von Klaus M.vdT. am 19.08.2014 13:19:06
        
        AW: ohne Schleife - von Stefanie am 19.08.2014 13:24:14

Betrifft: Schleifendurchlauf festlegen von: Stefanie
Geschrieben am: 19.08.2014 10:25:20

Ich hänge fest :-(

Mein Makro sucht in einer Spalte nach einem Wort (z.B. Hardware), darauf folgen weitere Anweisungen.

Das Wort Hardware kommt jetzt aber öfters vor in der Spalte und mein Makro soll aber nur bei dem ersten Fund quasi die restlichen Anweisungen abarbeiten.

Wie kann man dies realisieren ?

Hoffe ihr könnt mir helfen ich verweifel gerade!

VG

Betrifft: Exit For owT von: Rudi Maintaire
Geschrieben am: 19.08.2014 10:26:56

Betrifft: ohne schleife? von: Klaus M.vdT.
Geschrieben am: 19.08.2014 10:45:35

Hallo Stefanie,

ich kenne dein Makro natürlich nicht, aber vermute dass es auch ohne Schleife geht.

Beispiel suchen in Spalte B:
MeineZeile = Application.WorksheetFunction.Match("Hardware", Range("B1").EntireColumn, False)
MeineZeile ist die Zeile, in der das Wort "Hardware" steht.

ansonsten natürlich Exit for :-)

Grüße,
Klaus M.vdT.

Betrifft: ohne Schleife von: Rudi Maintaire
Geschrieben am: 19.08.2014 10:45:22

Hallo,
alternativ:

Sub aaa()
  Dim vRow
  vRow = Application.Match("Hardware", Columns(1), 0)
  If Not IsError(vRow) Then
    'mach was
  End If
End Sub

Sub bbb()
  Dim rFind As Range
  Set rFind = Columns(1).Find(what:="Hardware", lookat:=xlWhole, LookIn:=xlValues)
  If Not rFind Is Nothing Then
    'mach was
  End If
End Sub

Gruß
Rudi

Betrifft: AW: ohne Schleife von: Stefanie
Geschrieben am: 19.08.2014 11:18:30

Wie fügt man denn hier Code ein ? Dann kann ich es euch konkret an meinem Beispiel zeigen :-)

Betrifft: AW: ohne Schleife von: Klaus M.vdT.
Geschrieben am: 19.08.2014 12:32:15

Hi Stefanie,
füge den Code ein (STRG+C, STRG+V), markiere ihn und drücke den Button auf dem "CODE [PRE]" steht. Alles was zwischen [PRE] und [/PRE] steht wird als Code angezeigt.
Noch einfacher für uns ist es freilich, wenn du eine Musterdatei hochlädst. Dann können wir den Code gleich auf die Datei anpassen, statt Zeilen/Spaltenangaben erraten zu müssen.
Sensible Daten kannst du vorher durch "Max Mustermanns" ersetzen, und eine Reduzierung von großen Dateien auf das wesentliche ist auch immer gerne gesehen.

Grüße,
Klaus M.vdT.

Betrifft: AW: ohne Schleife von: Stefanie
Geschrieben am: 19.08.2014 12:45:01

Super danke da versuche ich es gleich mal.

Funktion 1

ist eine for each Schleife hier wird eine
Funktion 2 durchlaufen, die die variable "inhalt" prüft:

Funktion 2

If index_P <= 0 Then
index_P = 1
 If Inhalt = "Hardware" Then
   Columns.Find(What:=Inhalt, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False).EntireColumn.Select
    Selection.Copy
    Sheets("").Select
    Columns("H:H").Select
    ActiveSheet.Paste
    'Jetzt muss Asset noch umbenannt werden
    Sheets("").Select
    Cells(Q_Zeile, 4).Select
    Selection.Copy
    Sheets("").Select
    Cells(1, 8).Select
    ActiveSheet.Paste
    'Zellen einfärben
    Cells(1, 8).Interior.Color = RGB(255, 235, 156)
    'Nun müssen diese noch in Risikobeurteilung eingetragen werden
    Cells(1, 8).Select
    Bezeichnung = Cells(1, 8).Value
    'MsgBox Bezeichnung
    Sheets("Gefährdungen").Select
    Bereich = "H4:H49"
      For Each Zelle In Range(Bereich)
             If Zelle.Value = "x" Then
               Q_Zelle = "A" & Zeile_P
               Range(Q_Zelle).Activate
               Inhalt = ActiveCell.Value
               Selection.Copy
               Sheets("Risikobeurteilung").Select
              'Freie Zelle in Spalte B suchen und dort eintragen
               b = Cells(Rows.Count, 2).End(xlUp).Row + 1
               Cells(b, 2).Select
               ActiveSheet.Paste
               a = Cells(Rows.Count, 1).End(xlUp).Row + 1
               Cells(a, 1) = Bezeichnung
              End If
           Zeile_P = Zeile_P + 1
           Sheets("Gefährdungen").Select
       Next Zelle
 End If
End If

ich hab das jetzt mit der index variablen gelöst, wenn dieser Block einmal durchlaufen wurde wird index_P = 1 erhöht und somit wird der Block kein 2tes mal durchlaufen. Denkt ihr das ist ok so?

Würde jetzt nicht im Detail darauf eingehen, was der Block macht. Geht ja nur um das Verhindern eines 2 durchlaufes.

Danke für eure tolle Hilfe hier!!

Betrifft: AW: ohne Schleife von: Klaus M.vdT.
Geschrieben am: 19.08.2014 13:19:06

Hi,
ohne Kontext kann ich mit deinem Codefetzen leider nichts anfangen. Vielleicht lieber eine Musterdatei?

Um den Code etwas übersichtlicher zu halten, habe ich ihn mal exemplarisch von den überflüssigen .select und .activate befreit. Statt das hier jetzt breit zu erklären verweise ich auf das hervorragende Tutorial von Peter Haserodt zum Thema .select:
http://www.online-excel.de/excel/singsel_vba.php?f=78

If index_P <= 0 Then
index_P = 1
 If Inhalt = "Hardware" Then
   Columns.Find(What:=Inhalt, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False).EntireColumn.Copy
    With Sheets("")
        .Columns("H:H").PasteSpecial
        'Jetzt muss Asset noch umbenannt werden
        .Cells(Q_Zeile, 4).Copy
        .Cells(1, 8).PasteSpecial
        'Zellen einfärben
        .Cells(1, 8).Interior.Color = RGB(255, 235, 156)
        'Nun müssen diese noch in Risikobeurteilung eingetragen werden
        Bezeichnung = .Cells(1, 8).Value
    End With
        
    'MsgBox Bezeichnung
        Bereich = "H4:H49"
        With Sheets ("Gefährdungen")
          For Each Zelle In .Range(Bereich)
                 If Zelle.Value = "x" Then
                   Q_Zelle = "A" & Zeile_P
                   Inhalt = .Range(Q_Zelle).Value
                   .Range(Q_Zelle).Copy
                   
                   With Sheets("Risikobeurteilung")
                    'Freie Zelle in Spalte B suchen und dort eintragen
                      b = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
                      .Cells(b, 2).PasteSpecial
                      a = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                      .Cells(a, 1).Value = Bezeichnung
                   End With
                 End If
               Zeile_P = Zeile_P + 1  'Was macht Zeile_P?
           Next Zelle
        End With
 End If
End If

Grüße,
Klaus M.vdT.

Betrifft: AW: ohne Schleife von: Stefanie
Geschrieben am: 19.08.2014 13:24:14

Danke da schaue ich mir das Tutorial mal an!