Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
708to712
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
708to712
708to712
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige