Problem mit Makro
31.03.2009 11:19:45
Simon
ich hab mit folgendem Makro Probleme:
Wenn ein Wert nicht gefunden wird, dann bricht das Makro im fetten Teil ab, und es kommt eine msgbox.
Wie muss ich das Makro abändern, damit dann der nicht gefundene Wert als "" wiedergeben wird und das Makro weiterläuft. Die msgbox braucht es in diesem Falle auch nicht mehr.
Wäre euch sehr dankbar, wenn ihr mir helfen könntet!
Gruss Simon
Sub get_data()
If ToggleButton1 = False Then
MsgBox "Bitte Ausblende-Button aktivieren!", vbOKOnly, "Kritischer Fehler"
Else
'Dieses Macro versorgt Tabelle1 mit den Daten aus den Monatstabellen
Dim SearchStr As String, lCount As Long, rFoundCell As Range, WSh As Worksheet
Application.EnableEvents = False
For n = 1 To Sheets("Nach_Monate").Range("J4").Value 'Update nur fuer die gewaehlte Anzahl _
der Monate
'Tabellenname festlegen
Set WSh = Sheets("Monat" & n)
'erste Schleife bestimmt das erste Suchkriterium (Hauptgebiet z.b. Projekte)
For k = 1 To 10 '(10 Hauptgebiete in Tabelle "Nach_Monate")
'Festlegen des Suchkriterium, feste Struktur in Tabelle1
SearchStr = Worksheets("Nach_Monate").Cells(10 + (15 * (n - 1)), 2 + k).Value
Set rFoundCell = WSh.Range("A1")
For lCount = 1 To 10
Set rFoundCell = WSh.Columns(1).Find(What:=SearchStr, After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If rFoundCell Is Nothing Then
tmp = MsgBox("Die Hauptgruppe '" & SearchStr & "' aus Tabelle Nach_Monate _
existiert nicht in der Monatstabelle '" & WSh.Name & "' !" _
& vbCrLf & "Bitte überprüfen Sie die Schreibweise in der Monatstabelle _
und in Tabelle 'Nach_Monate'", vbCritical, _
"Kritischer Fehler")
If tmp = vbOK Or tmp = "" Then
Exit Sub
End If
ElseIf rFoundCell = SearchStr Then
foundaddress = rFoundCell.Address
Exit For
End If
Next lCount
'naechste Schleife bestimmt das 2te Suchkriterium (Untergruppe)
zz = 0
For m = 1 To 9 '(5 Untergruppen in Tabelle "Nach_Monate")
'suche nach unten in der Tabelle nach dem Wert aus Tabelle1
searchstr2 = Sheets("Nach_Monate").Cells(10 + m, 1).Value
'hier bis zur naechsten leeren Zelle suchen
If Not zz 0 Then
For z = 1 To WSh.Cells(Rows.Count, rFoundCell.Column).End(xlUp).Row
If WSh.Cells(rFoundCell.Row + z, rFoundCell.Column).Borders(xlEdgeBottom). _
LineStyle xlNone Then 'check on format
zz = zz + 1
Else
'naechste leere Zelle gefunden (kein Rahmen um die Zelle), abbrechen _
Zaehlschleife
Exit For
End If
Next z
lastrow = rFoundCell.Row + zz
End If
For i = rFoundCell.Row To lastrow
If WSh.Cells(1 + i, rFoundCell.Column + 2).Value = searchstr2 Then
'wenn Untergruppe gefunden wurde, Wert aus Spalte 6 in Tabelle 'Nach_Monate' _
uebernehmen
Sheets("Nach_Monate").Cells(10 + ((n - 1) * 15) + m, 2 + k).Value = WSh.Cells(1 _
+ i, 6).Value
Sheets("Nach_Monate").Cells(10 + ((n - 1) * 15) + m, 2 + k).Interior.ColorIndex _
= xlNone
i = lastrow
ElseIf i = lastrow Then
Sheets("Nach_Monate").Cells(10 + ((n - 1) * 15) + m, 2 + k).Value = ""
Sheets("Nach_Monate").Cells(10 + ((n - 1) * 15) + m, 2 + k).Interior.Color = _
RGB(500, 100, 30)
End If
Next i
Next m
Next k
Next n
Application.EnableEvents = True
End If
End Sub