Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Lösungsansatz

Forumthread: Lösungsansatz

Lösungsansatz
19.12.2005 13:00:40
Timo
Hi,
ich suche verzweifelt nach einem Lösungsansatz zu folgendem Probelm:
In einer Spalte stehen ca. 10000 Namen hintereinander. Die Namen können auch doppelt vorkommen. In den 3 Spalten daneben stehen Umsätze zu dem Namen. Mein Traum wäre folgendes:
Ein neues Sheet öffnen, den namen der 3 mal vorkommt 1 mal hinschreiben und danach die konsolidierten Umsätze. Kann mir da jemand helfen wie ich das am besten per Macro hinbekommen?
Gruß und Danke
Anzeige

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Lösungsansatz
19.12.2005 13:36:25
Galenzo
Pivottabelle
Viel Erfolg!
AW: Lösungsansatz
19.12.2005 13:41:27
UweD
Hallo
Hast du es mal mit einer Pivottabelle versucht?
(Daten, Pivottabelle)
...
- Namen in den Zeilenbereich
- Umsätze in den mittleren Summenbereich ziehen...
Gruß UweD
(Rückmeldung wäre schön)
AW: Lösungsansatz
19.12.2005 14:58:24
Heiko
Hallo Timo,
hier mal ein VBA Ansatz, wobei ich nicht so ganz verstanden habe wie deine Liste aufgebaut ist.
Mein Beispiel setz eine Liste Vorraus:
Spalte A: Namen (die ruhig doppelt in Spalte A vorkommen können.)
Spalte B, C und D: Umsätze zu den Namen in Spalte A, es muss nicht überall was drin stehen.
Ergebniss ist eine Liste mit den Umsätzen zu allen vorkommenen Namen, wenn der Name in verschiedenen Zeilen auftaucht werden die Umsätze aus allen Zeilen aufaddiert.

Sub SummeDerNamen()
Dim lngI As Long, lngArrCounter As Long
Dim dblUmsatz As Double
Dim strOldName As String
Dim arrNamen() As String
Dim arrUmsatz() As Double
Application.ScreenUpdating = False
' ****   Das Ausgangs Tabellenblatt anpassen  ****
Sheets("TabelleMitNamen").Copy after:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = "Namen Zusammenfassung"
ActiveSheet.UsedRange.Sort Key1:=ActiveSheet.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
strOldName = ActiveSheet.Cells(1, 1)
For lngI = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If ActiveSheet.Cells(lngI, 1).Text <> strOldName Then
ReDim Preserve arrNamen(lngArrCounter)
ReDim Preserve arrUmsatz(lngArrCounter)
arrNamen(lngArrCounter) = strOldName
arrUmsatz(lngArrCounter) = dblUmsatz
lngArrCounter = lngArrCounter + 1
dblUmsatz = ActiveSheet.Cells(lngI, 2) + ActiveSheet.Cells(lngI, 3) + ActiveSheet.Cells(lngI, 4)
strOldName = ActiveSheet.Cells(lngI, 1).Text
Else
dblUmsatz = dblUmsatz + ActiveSheet.Cells(lngI, 2) + ActiveSheet.Cells(lngI, 3) + ActiveSheet.Cells(lngI, 4)
End If
Next lngI
ReDim Preserve arrNamen(lngArrCounter)
ReDim Preserve arrUmsatz(lngArrCounter)
arrNamen(lngArrCounter) = strOldName
arrUmsatz(lngArrCounter) = dblUmsatz
ActiveSheet.Cells.Delete
ActiveSheet.Range("A1:A" & UBound(arrNamen) + 1) = Application.WorksheetFunction.Transpose(arrNamen)
ActiveSheet.Range("B1:B" & UBound(arrNamen) + 1) = Application.WorksheetFunction.Transpose(arrUmsatz)
Application.ScreenUpdating = True
End Sub

Gruß Heiko
PS: Rückmeldung wäre nett !
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige