Anzeige
Archiv - Navigation
1624to1628
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
Inhaltsverzeichnis

Summe wenn über VBA

Summe wenn über VBA
06.06.2018 08:57:42
Georg
Liebe Mitglieder,
folgendes soll (meiner Meinung nach) am besten über ein VBA Code gelöst werden.
Es soll eine Liste mit dem Nachnamen (Spalte A) in einem neuen Blatt generiert werden, wenn ein bestimmter Wert in Spalte D überschritten wird. z. B. 15
Die Liste sollte dann so aussehen gemäß der Beispielsdatei.
Maier 21
Wolter 42
Ich weiß es geht auch über Summe wenn, aber die Originaldatei ist wesentlich komplexer, und es wäre schön, wenn diese Übersicht durch einen VBA in einem neuen blatt generiert werden könnte. DANKE
https://www.herber.de/bbs/user/121982.xlsx

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Summe wenn über VBA
06.06.2018 09:01:49
ChrisL
Hi Georg
Summewenn einsetzen, Autofilter, kopieren, fertig. Lässt sich mit dem Makrorekorder aufzeichnen.
cu
Chris
AW: Summe wenn über VBA
06.06.2018 09:24:46
georg
Hallo Chris,
ich schaffe es so nicht. Das Original kann mehrere 100 Zeilen haben, wie kann ich eine Liste generieren, die
a) den Nachnamen prüft (also in wieviele Zeilen steht der gleiche Nachname) und dann aus diesen x-Zeilen die Summe bildet UND prüft, ist der Wert über 15?
Und nur dann bräuchte ich eine Übersichtsliste
AW: Summe wenn über VBA
06.06.2018 09:31:04
Daniel
HI
als reiner VBA-Code ohne Rückgriff auf Excelfunktionalitäten so:
Sub test2()
Dim arr, K
Dim z As Long, i As Long
Dim dic
Set dic = CreateObject("Scripting.dictionary")
arr = Sheets("Tabelle1").Cells(2, 1).CurrentRegion.Value
For z = 2 To UBound(arr)
dic(arr(z, 1)) = dic(arr(z, 1)) + arr(z, 4)
Next
ReDim arr(1 To dic.Count, 1 To 2)
For Each K In dic.Keys
If dic(K) > 15 Then
i = i + 1
arr(i, 1) = K
arr(i, 2) = dic(K)
End If
Next
Sheets("Tabelle2").Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub
Gruß Daniel
Anzeige
AW: Summe...GENIAL u DANKE
06.06.2018 09:43:38
Georg
Daniel, passt perfekt, auch wenn ich es nicht verstehe......
AW: Summe...GENIAL u DANKE
06.06.2018 09:52:45
Daniel
Hi
das solltest du aber tun, wenn du den Code verwenden willst.
verwendet wird hier das Dictionary-Objekt.
das Dictionary ist vereinfacht gesagt ein eindimensionales Array, bei welchem der Index durch einen beliebigen Freitext ("Key") gebildet werden kann.
so ist es z.B. möglich, für jeden Namen die Werte einfach aufzusummieren und gleichzeitig eine Duplikatfreie Liste dieser Namen zu bekommen, wenn man die Namen als Keys für das Dictionary verwendet.
in der zweiten Schleife werden dann die Dictionary-Ergebnisse in ein zweites Array zurückgeschrieben, wenn der Wert größer 15 ist.
falls dir das mit dem Dictionary zu komplex ist, dieser Code macht das gleiche, verwendet aber die entsprechenden Excelfunktionen (Duplikate-Entfernen, SummeWenn):
Sub Test()
Sheets("Tabelle1").Columns(1).Copy Sheets("Tabelle2").Cells(1, 1)
With Sheets("Tabelle2").Columns(1)
.RemoveDuplicates 1, xlYes
With .SpecialCells(xlCellTypeConstants).Offset(0, 1)
.FormulaR1C1 = "=SumIf(Tabelle1!C1,RC1,Tabelle1!C4)"
.Formula = .Value
.Cells(1, 1).Value = "Gesamt"
With .Offset(0, 1)
.FormulaR1C1 = "=IF(RC[-1]>15,Row(),0)"
.Cells(1, 1).Value = 0
.EntireRow.RemoveDuplicates .Column, xlNo
.ClearContents
End With
End With
End With
End Sub
Gruß Daniel
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige