| | | Leitfaden für die Materialauswahl im Spritzguss, ein Fachartikel
|
Autor
|
Thema: VBA Excel Tabelle zusammenfassen (1011 mal gelesen)
|
eday Mitglied Studentin
Beiträge: 2 Registriert: 01.06.2015
|
erstellt am: 01. Jun. 2015 19:38 <-- editieren / zitieren --> Unities abgeben:
Hallo, ich bin gerade dabei ein Makro zu erstellen und möchte dabei eine Tabelle zusammenfassen. Dabei sollen alle Zeilen von der Spalte F durchsucht werden. Falls der Inhalt (String) gleich ist, soll der Wert (Int) welcher in der gleichen Zeile, aber in Spalte E, ist aufaddiert werden und somit soll die Tabelle kleiner werden um unnötige Zeilen zu sparen: Datum X Y Z Wert Text 2.3 a b c 4 bla 3.5 a b c 8 lala 9.6 a b c 3 bla 5.2 a b c 5 lala c 20 aus dieser Tabelle soll werden: Datum X Y Z Wert Text 2.3 a b c 7 la 3.5 a b c 13 lala c 20 Ich bin leider noch Anfänger in VBA (Programmierkentnisse hab ich aber ) und habe ziemlich Probleme wegen der Dynamik. Manche Tabellen haben wenige Zeilen und manche sehr viele Zeilen. Über Hilfe würde ich mich sehr freuen Liebe Grüße ------------------ :-) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
MWN Mitglied Dipl.-Ing.
Beiträge: 492 Registriert: 14.02.2007
|
erstellt am: 02. Jun. 2015 08:52 <-- editieren / zitieren --> Unities abgeben: Nur für eday
Guten Morgen Eday, für heut Morgen: quick'n dirty Code: Option Explicit Sub sortieren() Dim i As Integer Dim strMerkerText As String Dim intMerkerZeile As Integer strMerkerText = "" For i = 2 To ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row Continue: If strMerkerText = "" Then strMerkerText = ActiveSheet.Cells(i, 6).Value intMerkerZeile = i i = i + 1 If (i > ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row) Then Exit For End If GoTo Continue End If If ActiveSheet.Cells(i, 6).Value = strMerkerText Then ActiveSheet.Cells(intMerkerZeile, 5).Value = CInt(ActiveSheet.Cells(intMerkerZeile, 5).Value) + CInt(ActiveSheet.Cells(i, 5).Value) ActiveSheet.Rows(i).Delete i = intMerkerZeile strMerkerText = "" End If Next End Sub
Gruß Tobias ------------------ Besucht mich doch mal in meiner Tischlerei "...Kommunikation ist nur so gut wie ihr Ergebnis..." - frei nach Richard Bandler / John Grinder "...Wenn du das tust, was du schon immer tust, wirst du auch nur das erhalten, was du schon immer erhalten hast..." Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 02. Jun. 2015 10:45 <-- editieren / zitieren --> Unities abgeben: Nur für eday
Hallo eday, Herzlich Willkommen im Forum Machbar ist vieles aber so ganz erschließt sich mir der Sinn dieses Programmes noch nicht, zumal man das mit Bordmitteln auch einfach lösen kann. Du kannst doch zum Einen die Datensätze anhand der Spalte F filtern und dann in eine andere Tabelle kopieren Oder Du sortierst nach Spalte F und A (bzw. Wert und Datum) und hast dann die Werte untereinander Wenn Du nur die Summen der Werte bezogen auf die Spalte F brauchst mach Dir eine Pivottabelle, dann bekommst Du gleich für alle F-Werte die Summen der Werte in Spalte E Aber vielleicht erklärst Du mal was Du wirklich brauchst. Grüße Klaus [edit]Hab Dir mal ein Beispielbild angehängt
[Diese Nachricht wurde von KlaK am 02. Jun. 2015 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
eday Mitglied Studentin
Beiträge: 2 Registriert: 01.06.2015
|
erstellt am: 02. Jun. 2015 21:19 <-- editieren / zitieren --> Unities abgeben:
Hallo Klaus Hallo Tobias, Vielen Dank für eure Antwort! Ich habe folgenden Code der super funktioniert: Option Explicit Sub summary() Dim rng As Range, rngC As Range Dim lngCol As Long On Error Resume Next Application.ScreenUpdating = False With ActiveSheet Set rng = .ListObjects(1).Range If rng Is Nothing Then Exit Sub .Copy after:=ActiveSheet End With With ActiveSheet .Name = rng.Parent.Name & " Summary" If .AutoFilterMode Then .ShowAllData .Range(.Cells(1, 7), .Cells(1, 8)) = "XXX" .Range(.Cells(2, 7), .Cells(rng.Rows.Count - 1, 7)).Formula = "=IF(OR(F2="""",COUNTIF($F$2:F2,F2)=1),""x"","""")" .Range(.Cells(2, 8), .Cells(rng.Rows.Count - 1, 8)).Formula = "=SUMIF(F:F,F2,E:E)" Set rngC = .Columns(7).SpecialCells(xlCellTypeFormulas) rngC = rngC.Value Set rngC = .Columns(8).SpecialCells(xlCellTypeFormulas) rngC = rngC.Value For Each rngC In .Range(.Cells(2, 7), .Cells(rng.Rows.Count - 1, 7)).SpecialCells(xlCellTypeConstants) rngC.Offset(0, -2) = rngC.Offset(0, 1).Value Next .Cells(1, 7).CurrentRegion.Sort .Cells(1, 7), xlAscending, Header:=xlYes Set rngC = .Range(.Cells(2, 7), .Cells(rng.Rows.Count - 1, 7)).SpecialCells(xlCellTypeBlanks) If Not rngC Is Nothing Then rngC.EntireRow.Delete .Columns(8).Delete .Columns(7).Delete End With Application.ScreenUpdating = True Set rng = Nothing Set rngC = Nothing End Sub Die eigentliche Tabelle ist riesig und komplizierter. Meine Aufgabe ist es einen auf Button-Druck automatischen Ablauf zu generieren um diese Tabelle zusammenzufassen Ich komme gut voran; bin aber lang nicht fertig mit dem gesamten Ablauf Vielen Dank nochmal Eday ------------------ :-) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|