Script anpassen ... - gescheitert :(
20.02.2024 11:34:39
DocLudwig
ich habe gerade versucht, ein bereits hier gepostetes Script an meine Bedürfnisse anzupassen. Bin leider kläglich gescheitert und hoffe, dass mir hier jemand unter die Arme greifen kann.
-----
Urspr. Frage von Ben:
"Ich habe eine Tabelle mit ca. 10.000 Zeilen und 9 Spalten.
In Spalte A steht in jeder Zeile ein Text, z.B. Material123 oder Material456. In den Spalten B bis F stehen unterschiedliche Werte.
Nun ist es so: Der Text in Spalte A kommt in mehreren Zeilen vor, aber die Werte in Spalte B bis F sind unterschiedlich.
Gerne möchte ich, dass von den Zeilen, die in A den gleichen Text haben, alle bis auf eine gelöscht werden. In der einzigen verbliebenen Zeile sollen die Werte aus den Spalten B, C, D... addiert werden."
Script von UweD
Option Explicit
Sub Makro1()
Dim LR
On Error GoTo Fehler
Columns("E:H").Insert Shift:=xlToRight
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"E1"), Unique:=True
LR = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row 'letzte Zeile der Spalte
Range("F2:H" & LR).FormulaLocal = "=SUMMEWENN($A:$A;$A2;B:B)"
Range("F:H").Copy
Range("F:H").PasteSpecial Paste:=xlPasteValues
Range("B1:D1").Copy Range("F1")
Columns("A:D").Delete Shift:=xlToLeft
Fehler:
If Err.Number > 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub-----
Bei meinen Daten handelt es sich um zwei Spalten. Spalte A enthält die Mehrfachangaben und Spalte B die Werte. Ich möchte jetzt praktisch das gleiche wie "Ben" allerdings mit nur zwei Spalten.
Beispieldaten
A B
353778 21
353778 15
353778 7
455897 23
455897 26
122457 4
122457 46
Hoffe, mir kann da einer weiterhelfen, da wir die Funktion täglich mehrmals brauchen könnten.
Danke im Voraus,
Grützi