Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1748to1752
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

MsgBox in Schleife

MsgBox in Schleife
06.04.2020 16:59:30
Peer
Hallo.
Wo muss ich eine MsgBox im Code einfügen, mit der ich nach Durchlaufen der Schleifen angezeigt werden soll, dass kein Eintrag gefunden wurde, ohne in eine Endlosschleife zu gelangen.
    For iRowA = 2 To Cells(Rows.Count, 1).End(xlUp).Row
For iRowB = iRowA + 1 To Cells(Rows.Count, 1).End(xlUp).Row
For iCol = 1 To 3
If Cells(iRowA, iCol).Value  Cells(iRowB, iCol).Value Then
bln = True
 MsgBox "Keinen Eintrag gefunden"
Exit For
End If
Next iCol
If Not bln Then
If Not blnColor Then
iColor = iColor + 1
End If
If Cells(iRowB, 1).Interior.ColorIndex = xlColorIndexNone Then
If Cells(iRowA, 1).Interior.ColorIndex = xlColorIndexNone Then
With Worksheets("Doppelt")
iRowC = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range(.Cells(iRowC, 1), .Cells(iRowC, 4)).Value = _
Range(Cells(iRowB, 1), Cells(iRowB, 4)).Value
End With
End If
Range(Cells(iRowA, 1), Cells(iRowA, 3)). _
Interior.ColorIndex = iColor
Range(Cells(iRowB, 1), Cells(iRowB, 3)). _
Interior.ColorIndex = iColor
blnColor = True
End If
End If
bln = False
Next iRowB
blnColor = False
Next iRowA
End Sub

Bestimmt hat jemand einen Rat für mich?
LG
Peer

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: MsgBox in Schleife
06.04.2020 17:28:33
Nepumuk
Hallo Peer,
so:
Option Explicit

Public Sub Vergleich()
    Dim iRowA As Long, iRowB As Long
    Dim iCol As Long, iColor As Long
    Dim iRowC As Long
    Dim bln As Boolean, blnColor As Boolean, blnFound As Boolean
    Columns("A:C").Interior.ColorIndex = xlColorIndexNone
    With Worksheets("Doppelt")
        .Range(.Cells(2, 1), .Cells(.Rows.Count, 3)).ClearContents
    End With
    iColor = 2
    For iRowA = 2 To Cells(Rows.Count, 1).End(xlUp).Row - 1
        For iRowB = iRowA + 1 To Cells(Rows.Count, 1).End(xlUp).Row
            For iCol = 1 To 3
                If Cells(iRowA, iCol).Value <> Cells(iRowB, iCol).Value Then
                    bln = True
                    Exit For
                End If
            Next iCol
            If Not bln Then
                blnFound = True
                If Not blnColor Then iColor = iColor + 1
                With Worksheets("Doppelt")
                    iRowC = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    .Range(.Cells(iRowC, 1), .Cells(iRowC, 3)).Value = _
                        Range(Cells(iRowB, 1), Cells(iRowB, 3)).Value
                End With
                Range(Cells(iRowA, 1), Cells(iRowA, 3)). _
                    Interior.ColorIndex = iColor
                Range(Cells(iRowB, 1), Cells(iRowB, 3)). _
                    Interior.ColorIndex = iColor
                blnColor = True
            End If
            bln = False
        Next iRowB
        blnColor = False
    Next iRowA
    If Not blnFound Then MsgBox "Keinen Eintrag gefunden"
End Sub

Gruß
Nepumuk
Anzeige
AW: MsgBox in Schleife
06.04.2020 17:35:19
Peer
Hallo Nepumuk.
Vielen Dank.
Da wäre ich lange Zeit nicht drauf gekommen.
LG
Peer

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige