Fehlermeldung
sigi
in einer UF soll nach verschiedenen Kriterien eine Listbox gefüllt werden.
Ist kein Datensatz vorhanden erscheint eine Fehlermeldung
Ist der Datensatz vorhanden wird die Listbox damit gefüllt.
Der nachfolgende Code funktioniert zwar, jedoch erscheint die Fehlermeldung immer
wieder bis der Datensatz gefunden wird.
So kommt nun die Fehlermeldung zB. 3 mal weil der Datensatz in Zeile 4 steht.
Wie kann ich dies vermeiden?
Danke!
Gruß
Sigi
Private Sub CommandButton10_Click()
Dim WB, A, A1, A2, B, B1, B2 As Variant
Dim wks As Object
Dim arr()
Dim Endrow%, iRow%, iRowU%, I%
On Error Resume Next
WB = ThisWorkbook.Name
Set wks = Workbooks(WB).Sheets("RGJour")
Endrow = wks.Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 2 To Endrow
If wks.Cells(iRow, 4) Me.TextBox2 And _
wks.Cells(iRow, 5) Me.TextBox8 And _
wks.Cells(iRow, 6) Me.TextBox9 And _
wks.Cells(iRow, 7) Me.TextBox10 Then
MsgBox "Keine Rechnung für dieses Projekt geschrieben!"
ElseIf wks.Cells(iRow, 4) = Me.TextBox2 And _
wks.Cells(iRow, 5) = Me.TextBox8 And _
wks.Cells(iRow, 6) = Me.TextBox9 And _
wks.Cells(iRow, 7) = Me.TextBox10 Then
GoTo weiter01
End If
Next iRow
weiter01:
With Me
.MultiPage1.Page3.Visible = True
.MultiPage1.Value = 2
.ListBox2.Clear
End With
Endrow = wks.Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 2 To Endrow
If Not IsEmpty(wks.Cells(iRow, 1)) And wks.Cells(iRow, 4) = Me.TextBox2 And _
wks.Cells(iRow, 5) = Me.TextBox8 And _
wks.Cells(iRow, 6) = Me.TextBox9 And _
wks.Cells(iRow, 7) = Me.TextBox10 Then
ReDim Preserve arr(0 To 8, 0 To iRowU)
arr(0, iRowU) = wks.Cells(iRow, 1)
arr(1, iRowU) = wks.Cells(iRow, 2)
arr(2, iRowU) = wks.Cells(iRow, 3)
arr(3, iRowU) = wks.Cells(iRow, 8)
arr(3, iRowU) = FormatNumber(arr(3, iRowU), 2)
arr(4, iRowU) = wks.Cells(iRow, 9)
arr(4, iRowU) = FormatNumber(arr(4, iRowU), 2)
arr(5, iRowU) = wks.Cells(iRow, 10)
arr(5, iRowU) = FormatNumber(arr(5, iRowU), 2)
arr(6, iRowU) = wks.Cells(iRow, 11)
arr(6, iRowU) = FormatNumber(arr(6, iRowU), 2)
arr(7, iRowU) = wks.Cells(iRow, 12)
arr(8, iRowU) = wks.Cells(iRow, 13)
arr(8, iRowU) = FormatNumber(arr(8, iRowU), 2)
iRowU = iRowU + 1
End If
Next iRow
Me.ListBox2.Column = arr
For iRow = 2 To Endrow
If wks.Cells(iRow, 12) = "bezahlt" And _
wks.Cells(iRow, 4) = Me.TextBox2 And _
wks.Cells(iRow, 5) = Me.TextBox8 And _
wks.Cells(iRow, 6) = Me.TextBox9 And _
wks.Cells(iRow, 7) = Me.TextBox10 Then
A = A + wks.Cells(iRow, 8)
A1 = A1 + wks.Cells(iRow, 9)
A2 = A2 + wks.Cells(iRow, 10)
End If
Next iRow
For iRow = 2 To Endrow
If wks.Cells(iRow, 12) = "offen" And _
wks.Cells(iRow, 4) = Me.TextBox2 And _
wks.Cells(iRow, 5) = Me.TextBox8 And _
wks.Cells(iRow, 6) = Me.TextBox9 And _
wks.Cells(iRow, 7) = Me.TextBox10 Then
B = B + wks.Cells(iRow, 8)
B1 = B1 + wks.Cells(iRow, 9)
B2 = B2 + wks.Cells(iRow, 10)
End If
Next iRow
With Me
.TextBox20 = A
.TextBox21 = A1
.TextBox22 = A2
.TextBox23 = B
.TextBox24 = B1
.TextBox25 = B2
.TextBox20 = FormatNumber(.TextBox20, 2)
.TextBox21 = FormatNumber(.TextBox21, 2)
.TextBox22 = FormatNumber(.TextBox22, 2)
.TextBox23 = FormatNumber(.TextBox23, 2)
.TextBox24 = FormatNumber(.TextBox24, 2)
.TextBox25 = FormatNumber(.TextBox25, 2)
End With
ende:
End Sub
Anzeige