Office: Makro: Gleiche Werte Zusammenfassen

Hallo miteinander,

nach meiner letzten Kalkulation habe ich mich mal rangesetzt um mich etwas mit Makros/ VBA zu beschäftigen (bisher nur in Delphi programmiert, aber trotz Syntax einen guten Einstieg gehabt)

Nun habe ich folgende Problemstellung:

2 Tabellenblätter:

Blatt A : Rechnung
Blatt B : Bedarf

Bei B stehen Artikel und Preis,
mit dem Button "Hinzufügen" wird mein Makro aktiviert und die Daten von B, in meine Tabelle in Blatt A übernommen.

Soweit konnte ich alles umsetzen (abgesehen davon dass er die Daten nur in das aktive Blatt und nicht auf Worksheets("Rechnung") übertragen möchte). Jeder Eintrag wird auch in einer neuen Zeile generiert.

Nun soll das Makro irgendwie erkennen, dass ich einen Bestimmten Artikel mehrmals eingefügt habe und diesen dann addieren:

Beispiel:

Ich klicke 2x auf "Hinzufügen", bei beiden Malen haben wir "Artikel 1" gewählt. Nun steht in der Tabelle aber nicht zwei mal "Artikel 1" untereinander, sondern nur einmal "Artikel 1", die Preise und der Bedarf in den hinteren Spalten wurde demzufolge auch zusammengerechnet.

Also Artikel 1 = 10€ + Artikel 1 = 20€ macht in der Tabelle ein Eintrag "Artikel 1" = 30€.

Müsste dann so funktionieren, dass er bei einem bestand von über 100 Artikeln erkennt wann dopplungen auftreten und diese dann addiert.

Umsetzungsideen bin ich mir noch nicht schlüssig ob ich es mit If Then probiere oder mit nem Array, leider sind meine VBA kenntnisse in der hinsicht etwas unausgereift :S

Hier mals das Makro soweit wie ich es habe

Code:

Sub Test()
'
' Test Makro
'

'
'    Sheets("Rechnung").Select

Dim b_bedarf As Range
Dim b_artikel As Range
Dim b_pnetto As Range

Set b_artikel = Worksheets("Bedarf").Range("B6")
Set b_bedarf = Worksheets("Bedarf").Range("B10")
Set b_pnetto = Worksheets("Bedarf").Range("B13")

Dim neueZeile As Range, freieZeile As Integer
Set neueZeile = Range("A25:A30").Find("")

freieZeile = neueZeile.Row


Cells(freieZeile, 1).Value = (b_artikel)
Cells(freieZeile, 3).Value = (b_bedarf)
Cells(freieZeile, 4).Value = (b_pnetto)


End Sub

http://www.file-upload.net/download-1766643/Makro_addieren.xlsx.html

 

Soo, bevor ich schlafen gehe noch das was mir gerade eingefallen ist.

das Makro soll einfach die einträge vergleichen und bei einer dopplung nen strich aufs kerbholz machen und die werte addieren.

Implementierung in Excel wusste ich jezt leider nicht wie ich das anstellen soll, setzte mich aber morgen/ heute mal ran.

vilt kann ja jmd mit dem ansatz schon was anfangen, oder hat eine einfachere lösung?

das ist jetzt delphi

Code:

Var
artikel : array[1..2500] of Tlistitem;

procedure Button1Click
var
neuerArtikel : Tlistitem;
dopplung, j, i:integer;
button: Integer;

begin

inc(anzahl)
artikel[anzahl] :=neuerArtikel;

for i:=1 to anzahl do begin
if (artikel[i].caption = artikel[i+1].caption)
	then inc(dopplung);
end;
if dopplung > 1 then
	artikel[i].caption + doppelter eintrag

end;

 

Code:

Sub Test()
[...]
Set neueZeile = Range("A25:A30").Find("")
freieZeile = neueZeile.Row

Mit diesem Konstrukt patscht Du den Eintrag immer und grundsätzlich an das Ende der Liste. Das Herausfinden, ob der Artikel bereits vorher schon in der Liste war, muß also vorher passieren.

Irgendwas in der Art (und das sieht in VBA eigentlich fast genauso aus, wie in Delphi):

Code:

i = 1
while i < freizeile
    if cells(i,1).value = b_artikel then
        cells(i,3) = cells(i,3) + 1 'anzahl anpassen
        'cells(i,4) anpassen...
'(ich mag kein "exit for", deswegen der etwas umständlichere weg über "while"
        i = freiezeile
    endif
    i = i + 1
wend
if i = freiezeile then
'bei dopplung wäre i = freiezeile+1
    cells(freiezeile,1).value = (b_artikel) 
    cells(freiezeile,3).value = (b_bedarf) 
    cells(freiezeile,4).value = (b_pnetto)
endif

Ist jetzt aus'm Stegreif so hingetippselt, aber das Prinzip dürfte klar sein, oder?

Gruß, Michael

 

Hallo noctis,

ich habe Dir VBA-Code gebastelt, der die seit Excel2007 neuen Tabellen verwendet.
Im Blatt 'Bedarf' sind 2 Buttons enthalten:
der 1.Button dient zum Erzeugen der Rechnungstabelle im Blatt 'Rechnung';
der 2.Button dient zum Hinzufügen einer Artikelposition: falls der Artikel bereits existiert, werden nur die beiden Spalten 'Bedarf' und 'Gesamtpreis' entsprechend erhöht.

Hier der Link auf die Excel2007-Datei:
http://www.file-upload.net/download-1771911/noctis_Makro_addieren.xlsm.html