Makro Ergänzung - wahrscheinlich einfach

Forumthread: Makro Ergänzung - wahrscheinlich einfach

24.02.2007 17:48:40

aridder

Hallo zusammen,
für die vielen Profis hier wahrscheinlich kein Problem...:-)
Die folgende Datei enthält ein Makro:
https://www.herber.de/bbs/user/40658.xls
Als Ergänzung soll das Makro als ersten Schritt nun folgendes machen:
ausgehend von der Zeile "Zeile2 + 3" soll das Makro einen Bereich markieren und löschen.
Der Bereich wird bestimmt durch folgende Parameter:
Tiefe: ausgehend von "Zeile2 + 3" / Spalte 3 werden alle darunterliegenden ausgefüllten Zeilen berücksichtigt
Breite: ausgehend von Zeile 12 / Spalte 5 alle ausgefüllten rechtsliegenden Felder
Leider habe ich keine VBA Ahnung und hoffe, dass ich mich verständlich ausfrücken konnte! Vielen Dank schon mal und noch einen schönen Tag!
Viele Grüße
Andreas

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro Ergänzung - wahrscheinlich einfach

24.02.2007 21:03:00

fcs

AW: Makro Ergänzung - wahrscheinlich einfach

24.02.2007 21:03:00

fcs

Hallo Andreas,
Passe das Makro wie folgt an.
Gruss
Franz

Sub Summenberechnung()
Dim wks As Worksheet
Dim Zeile1 As Long, Zeile2 As Long, Produkte As Range, Monat As Range
Dim SpalteL As Integer, ZeileL as Long
Set wks = ActiveWorkbook.Worksheets("KA Plange")
With wks
Zeile1 = 13
'Letzte Datenzeile in Spalte A
Zeile2 = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
'Letzte DatenSpalte in Zeile 12
SpalteL = .Cells(12, .Columns.Count).End(xlToLeft).Column
'Letzte DatenZeile in Spalte C
ZeileL = .Cells(.Rows.Count, 3).End(xlUp).Row
'Zellinhalte im Ausgabebereich löschen
.Range(.Cells(Zeile2 + 3, 3), .Cells(IIf(ZeileL > Zeile2 + 3, ZeileL, Zeile2 + 3), SpalteL)).ClearContents
'Produktliste erstellen, Spalte C wird durchsucht und Produkte ohne doppelte unterhalb der Liste eingetragen
For Zeile = Zeile1 To Zeile2 Step 3
ZeileP = Zeile2 + 3 'Ergebnisse werden 3 Zeilen unterhalb der letzten Datenzeile eingetragen
Do
If IsEmpty(.Cells(ZeileP, 3)) Then
.Cells(ZeileP, 3).Value = .Cells(Zeile, 3).Value
Exit Do
Else
If .Cells(ZeileP, 3).Value = .Cells(Zeile, 3).Value Then Exit Do
End If
ZeileP = ZeileP + 1
Loop
Next
'Produktliste sortieren
.Range(.Cells(Zeile2 + 3, 3), .Cells(.Rows.Count, 3).End(xlUp)).Sort _
Key1:=.Cells(Zeile2 + 3, 3), Order1:=xlAscending, Header:=xlNo
'Ergebnisse für verbindliche Kontrakte berechnen
Set Produkte = .Range(.Cells(Zeile1, 3), .Cells(Zeile2, 3))
For Spalte = 5 To .Cells(Zeile2, .Columns.Count).End(xlToLeft).Column
If IsDate(.Cells(12, Spalte)) Then 'Spalte D-Preis 1-12 wird nicht ausgefüllt
Set Monat = .Range(.Cells(Zeile1, Spalte), .Cells(Zeile2, Spalte))
For Zeile = Zeile2 + 3 To .Cells(.Rows.Count, 3).End(xlUp).Row
.Cells(Zeile, Spalte).Value = SummeVerbindlich(.Cells(Zeile, 3), Produkte, Monat)
Next
End If
Next
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Makro Ergänzung - wahrscheinlich einfach

Forumthread: Makro Ergänzung - wahrscheinlich einfach

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread