Zeilen vergleich und addieren mit Vba

Computer: Software & Programmierung Office Software
1

Hallo

ich möchte ein Makro schreiben, dass mir eine Datei öffnet und Zeilen vergleicht ob sie gleich sind und dann addiert und diese Zeile dann mit einem „o“ markiert.

kleines Beispiel
Datum Uhrzeit Nr
091025 02:00 1 59 244
091025 02:00 2 40 195
091025 03:00 1 36 162
091025 03:00 2 24 167
091025 03:00 1 29 138
091025 03:00 2 29 142
091025 04:00 1 14 136
091025 04:00 2 30 121

daraus soll werden
091025 02:00 1 59 244
091025 02:00 2 40 195
091025 03:00o1 65 300
091025 03:00o2 53 309
091025 04:00 1 14 136
091025 04:00 2 30 121

Das „o“ soll zwischen der Uhrzeit und 1bzw2 in eine eigene Spalte kommen.

hoffe mein Problem ist verständlich geworden. Wenn nicht fragt einfach :smile:

also mit dem öffen hab ich kein Problem, nur ich weiss nicht wie ich das mit dem vergleichen und addieren anstellen soll

2

Datum Uhrzeit Nr
091025 02:00 1 59 244
091025 02:00 2 40 195
091025 03:00 1 36 162
091025 03:00 2 24 167
091025 03:00 1 29 138
091025 03:00 2 29 142
091025 04:00 1 14 136
091025 04:00 2 30 121

daraus soll werden
091025 02:00 1 59 244
091025 02:00 2 40 195
091025 03:00o1 65 300
091025 03:00o2 53 309
091025 04:00 1 14 136
091025 04:00 2 30 121
also mit dem öffen hab ich kein Problem, nur ich weiss nicht
wie ich das mit dem vergleichen und addieren anstellen soll

Hallo Tobi,

Sub Makro1()
Dim Zei1 As Long, Zei3 As Long
On Error GoTo Ende
Application.ScreenUpdating = False
With Worksheets("Tabelle3")
 .Activate
 .UsedRange.ClearContents
 Worksheets("Tabelle1").Range("A1:C1").Copy Destination:=.Range("A1")
 Zei1 = Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
 Worksheets("Tabelle1").Range("A1:C" & Zei1).AdvancedFilter Action:=xlFilterCopy, \_
 CopyToRange:=.Range("A5"), Unique:=True
 .Rows("1:4").Delete
 Zei3 = .Cells(Rows.Count, 1).End(xlUp).Row
 .Range("E2").FormulaArray = \_
 "=SUM(IF((Tabelle1!R1C1:R" & Zei1 & "C1=RC1),IF(Tabelle1!R1C2:R" & Zei1 & "C2=RC2," \_
 & "IF(Tabelle1!R1C3:R" & Zei1 & "C3=RC3,Tabelle1!R1C[-1]:R" & Zei1 & "C[-1]))))"
 .Range("E2").Copy Destination:=.Range("F2")
 .Range("E2:F2").Copy Destination:=.Range("E3:F" & Zei3)
 .Range("D2:smiley:" & Zei3).FormulaR1C1 = \_
 "=IF(SUMPRODUCT((Tabelle1!R1C1:R" & Zei1 & "C1=RC[-3])\*(Tabelle1!R1C2:R" & Zei1 & "C2=RC[-2])" \_
 & "\*(Tabelle1!R1C3:R" & Zei1 & "C3=RC[-1]))\>1,""o"","""")"
 .Range("A2:F" & Zei3).Value = .Range("A2:F" & Zei3).Value
 .Range("A:F").Columns.AutoFit
End With
Ende:
Application.ScreenUpdating = True
End Sub

Gruß
Reinhard

3

Danke

Hab leider ins falsche Forum gepostet.

Die Eingangs und Ausgangsdatei ist eine normale Textdatei und keine Excel. Wie sieht das dann aus? Weil da hab ich ja keine A1 usw.