summewenn Fkt. als Makro
meixner
habe ein Problem mit einem Makro. Anhand eines Makros wird eine Tabelle kopiert mit range(AX :BA) und in eine andere Excel - Mappe kopiert. Ich möchte, aber das dieses Makro gleichzeitig vor kopieren eine summewenn - Funktion ausführt.
Die Fkt. heisst: summewenn(AX:AX; AX8; BA:BA), damit manche Daten nicht doppelt vorkommen.
Bsp. Tabelle die in die andere Excelmappe kopiert werden soll:
Spalte AX Spalte AY Spalte BA Spalte BB
28 S 576 15542
29 S 5.610 5610
8 S 954 1717
28 S 8.312 15542
2 S 136.940 136940
8 S 763 1717
25 S 5.058 5058
28 S 6.654 15542
Das Problem ist, das die Nr. 28 hier 3x vorkommt. Deshalb soll das Makro für die Nr. 28 anhand eines Makros die Zahlen in spalte BB zusammenfassen und als eine Zeile in die neue Excel - Arbeitsmappe eintragen.
In die neue Arbeitsmappe soll nicht die 3x mal die Zeile 28 vorkommen, sondern nur einmal und dafür aber zusammengezählt die Zahlen aus Spalte BB.
Spalte AX Spalte AY Spalte BA
28 S 576
28 S 8.312
28 S 6.654
In der neuen Excel - Mappe soll nur noch
Spalte AX Spalte AY Spalte BA
28 S 15.542
auftauchen.
Kann mir jmd. dabei helfen dies zusammenzufassen. Wie kann ich eine Summewenn - fkt. als Makro schreiben und das so formulieren, das z.B. die Zeile mit Nr. 28 nur einmal auftaucht. Unten das Makro.
Vielen Dank
Dani.
Sub ordersheet_erstellen()
Dim wbReweighting As Workbook
Dim wsReweighting As Worksheet
Dim wbParameter As Workbook
Dim wsParameter As Worksheet
Dim wbOrdersheet As Workbook 'das neue Excel _
Sheet als Workbook definieren
Dim wsOrdersheet As Worksheet 'das Ziel- _
Arbeitsblatt als Arbeitsblatt definieren
Dim nameTemplate As String 'Name Template _
als String definieren
Dim nameOrdersheet As String 'Name fertiges _
Ordersheet as String definieren
Dim letztevolleZeile As Long
Application.ScreenUpdating = False
Dim NameDatei As String
Dim zu_kopierenden_Bereich As String
NameDatei = ThisWorkbook.Name
zu_kopierenden_Bereich = "Ax11:ba"
Set wbReweighting = Application.Workbooks("Template_alle_Kapitalmaßnahmen.xls")
Set wsReweighting = wbReweighting.Worksheets(1)
Set wbParameter = Application.Workbooks("Template_alle_Kapitalmaßnahmen.xls")
Set wsParameter = wbReweighting.Worksheets("Parameter")
nameTemplate = wsParameter.Cells(74, 2).Value 'liest Namen _
des zu öffnenden Template aus Zelle 4,2 des Arbeitsblatt "Parameter"
nameOrdersheet = wsParameter.Cells(75, 2).Value 'liest Names _
des fertigen Ordersheets aus Zelle 5,2 des Arbeitsblatt "Parameter"
letztevolleZeile = wsReweighting.Cells(Rows.Count, 1).End(xlUp).Row 'sucht letzte _
volle Zeile in Spalte 2
If MsgBox("Hast Du vor Erstellung des Anteilebelege per Reuters Real Time alle Kurse _
aktualisiert?", vbOKCancel, "Warnung") = vbCancel Then
Exit Sub
End If
Set wbOrdersheet = Application.Workbooks.Open(nameTemplate) 'Order Template ö _
ffnen
Set wsOrdersheet = wbOrdersheet.Worksheets(1) '1. Arbeitsblatt _
des neuen Excel Sheet als Ziel Arbeitsblatt bestimmen
wsReweighting.Range(zu_kopierenden_Bereich & letztevolleZeile).Copy 'zu kopierenden _
Bereich definieren und kopieren
wsOrdersheet.Range("a13").Activate 'Ordersheet _
aktivieren & bestimmen, ab wo Daten eingefügt werden
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False 'zu kopierenden _
Bereich mit "paste special" einfügen
wsOrdersheet.Range("B4").Value = wsParameter.Range("B85").Value 'Name Fonds in _
Ordersheet schreiben
wsOrdersheet.Range("e13:e100").Value = wsParameter.Range("B85").Value '"Created" _
in Ordersheet schreiben
wsOrdersheet.Range("f13:f100").Value = wsParameter.Range("B86").Value 'Valuta in _
Ordersheet schreiben
wsOrdersheet.Range("c13:c100").Value = wsOrdersheet.Range("f4").Value
'Im Ticket werden die Daten sortiert, überflüssige Werte werden entfernt.
wsOrdersheet.Range("A13:h100").Select 'Gesamtbereich _
wird markiert
Selection.Sort Key1:=Range("a13"), Order1:=xlDescending, Key2:=Range("h13" _
), Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal 'Sortieren nach _
Spalte e, dann Spalte B
Rows(wsParameter.Cells(82, 2).Value).Select 'Löschbereich ( _
siehe Parameter) wird gelöscht
Selection.Delete Shift:=xlUp
wsOrdersheet.Range("a1").Activate 'Zelle A1 _
aktivieren, damit gelöschter Bereich nicht mehr markiert ist
wbOrdersheet.SaveAs nameOrdersheet 'Ordersheet wird _
abgespeichert
wbOrdersheet.Close 'Ordersheet wird _
geschlossen
Application.ScreenUpdating = True 'aktiviert _
Bildschirmaktualisierung
End Sub