Makro übersetzen..!
27.03.2009 06:48:32
Jan_E
kann mir jemand bitte den fett markierten Teil übersetzen oder besser gesagt, interpretieren. Ich wäre sehr dankbar, denn sonst komme ich beinahe unmöglich bei meiner Arbeit weiter.
Sub get_data()
'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("Übersicht").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 "Übersicht")
'Festlegen des Suchkriterium, feste Struktur in Tabelle1
SearchStr = Worksheets("Übersicht").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 Übersicht _
existiert nicht in der Monatstabelle '" & WSh.Name & "' !" _
& vbCrLf & "Bitte überprüfen Sie die Schreibweise in der Monatstabelle _
und in Tabelle 'Übersicht'", 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 "Übersicht")
'suche nach unten in der Tabelle nach dem Wert aus Tabelle1
searchstr2 = Sheets("Übersicht").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 'Übersicht' _
uebernehmen
Sheets("Übersicht").Cells(10 + ((n - 1) * 15) + m, 2 + k).Value = WSh.Cells(1 + _
i, 6).Value
Sheets("Übersicht").Cells(10 + ((n - 1) * 15) + m, 2 + k).Interior.ColorIndex = _
xlNone
i = lastrow
ElseIf i = lastrow Then
Sheets("Übersicht").Cells(10 + ((n - 1) * 15) + m, 2 + k).Value = ""
Sheets("Übersicht").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 Sub
Sucht da der Code nach Rahmen? Wie sieht dieser Rahmen aus? Was bedeutet ZZ? Was macht der Code in diesem Teil?
Sonst habe ich den Code eingentlich durchschaut, habe aber mit dem markierten Teil noch Mühe.
Vielen Dank für eure Mühe und noch einen schönen Tag (bie hoffentlich schönerem Wetter, als momentan hier in der Schweiz herrscht!:)
Gruss
JAn_E