AW: Makro mit Button aufrufen
17.11.2009 13:52:53
Joni
Hi Björn,
das Makro des Buttons ist in dem entsprechenden Tabellenblatt.
Die Prozedur steht unter Modul in Modul2.
Alle Variablen sind in der Prozedur definiert.
Sub Buchungen_einfügen()
Dim SK As String 'Suchkriterium, Personennummer
Dim i As Variant 'Beginnzeile der Schleife beim Auslesen
Dim j As Variant 'Beginnzeile der Schleife beim Einfügen
Dim j1 As Variant 'Beginnzeile merken für später
Dim k As Variant 'Durchläufe zählen für Formel
j = 24
j1 = j
With Sheets("Kontoauszug")
SK = Cells(2, 1)
End With
With Sheets("Buchungen")
For i = 2 To 50000 Step 1
If .Cells(i, 17) = SK Then 'Personennummer suchen
If .Cells(i, 16) = 1 Then 'nur immer die erste Zeile verwenden
If .Cells(i, 10) = "P" Then 'nur Buchungen von Personen berücksichtigen
Sheets("Kontoauszug").Cells(j, 1) = .Cells(i, 4) 'Datum Wert übernehmen
Sheets("Kontoauszug").Cells(j, 2) = .Cells(i, 15) 'Text Wert übernehmen
If .Cells(i, 7) = "S" Then
Sheets("Kontoauszug").Cells(j, 3) = .Cells(i, 11) 'Sollbetrag Wert ü _
bernehmen
Sheets("Kontoauszug").Cells(j, 4) = 0
Else
Sheets("Kontoauszug").Cells(j, 4) = .Cells(i, 11) 'Habenbetrag Wert ü _
bernehmen
Sheets("Kontoauszug").Cells(j, 3) = 0
End If
k = k + 1
If k = 1 Then Sheets("Kontoauszug").Cells(j, 5).FormulaR1C1 = "=RC[-1]-RC[- _
2]"
If k > 1 Then Sheets("Kontoauszug").Cells(j, 5).FormulaR1C1 = "=R[-1]C+RC[- _
1]-RC[-2]"
j = j + 1
End If
End If
End If
If .Cells(i, 1) = "" Then GoTo Ende
Next
End With
Ende:
With Sheets("Kontoauszug")
.Cells(j, 2) = "Summe"
.Cells(j, 3).FormulaR1C1 = "=SUM(R[-" & (j - j1) & "]C:R[-1]C)"
.Cells(j, 4).FormulaR1C1 = "=SUM(R[-" & (j - j1) & "]C:R[-1]C)"
.Cells(j, 5).FormulaR1C1 = "=R[-1]C"
End With
With .Range(Cells(j, 1), Cells(j, 5))
With .Borders(xlEdgeTop) 'Rahmen oben
.LineStyle = xlContinuous 'einfacher Strich
.Weight = xlThin 'dünner Strich
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom) 'Rahmen unten
.LineStyle = xlDouble 'dopppelter Strich
.ColorIndex = xlAutomatic
End With
End With
End Sub
Gruß Joni