Doppelte Einträgen Suchen

Private Sub CommandButton1_Click() Dim lngZeile As Long Dim lngEnde As Long Dim i As Integer lngEnde = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row For lngZeile = 1 To ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row If Application.CountIf(Range("F2:F" & lngEnde), Range("F" & lngZeile)) > 1 Then Range("F" & lngZeile).Interior.ColorIndex = 3 End If Next lngZeile End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Falo,
kannst du mal eine kleine Beispieldatei mit einer Vorher- und einer Nachhertabelle hochladen?
Wichtig:
1. Sind die Daten in Spalte F sortiert, d.h. sind die doppelten jeweils in Zeilenblöcken angeordnet?
2. Sind bei den doppelten in Spalte F die Daten in den Spalten A bis G identisch? Wenn Nein: aus welcher Zeile sollen die Werte A:G in die Summenzeile kopiert werden?
Sieht man mal von dem Kopieren der Zellen A:G in die Summenzeile ab, dann macht man solche Summenauswertungen mit einem Pivottabellenbericht oder bei Daten sortiert nach Spalte F mit dem Einfügen von Teilergebnissen via Menü Daten.
Dabei müssen dann in der 1. Zeile des auszuwertenden Datenbereichs Spaltentitel stehen.
Gruß
Franz

Hallo Olaf,
hier schon mal ein Makro, das bei mehreren aufeinander folgenden identischen PersonalNrn eine Summenzeile oberhalb einfügt. Prüfe mal ob das Ergebnis stimmt.
Die Integration in das Importmakro muss ich noch prüfen.
Was ist mit dem Eintrag "MA" in Spalte P? Solldieser dann nggf. in der Summenspalte erfolgen?
Gruß
Franz

Sub prcSummierenIdentischePersNr()
Dim wks As Worksheet
Dim Zeile As Long
Dim dblSumme As Double
Dim iCount As Integer
Dim lngFarbe As Long
Dim varPersNr
lngFarbe = RGB(255, 0, 0) 'rot
Set wks = ActiveWorkbook.Worksheets(1)
Application.ScreenUpdating = False
With wks
For Zeile = .Cells(.Rows.Count, 6).End(xlUp).Row To 1 Step -1
If varPersNr  .Cells(Zeile, 6).Text Then
If iCount > 1 Then
.Rows(Zeile + 1).Insert
.Range(.Cells(Zeile + 2, 6), .Cells(Zeile + 1 + iCount, 6)).Interior.Color = lngFarbe
.Range(.Cells(Zeile + 1, 1), .Cells(Zeile + 1, 11)).Interior.Color = lngFarbe
.Cells(Zeile + 1, 6) = "'" & varPersNr
.Cells(Zeile + 1, 7) = .Cells(Zeile + 2, 7)
.Cells(Zeile + 1, 10) = dblSumme
End If
If Zeile = 1 Then Exit For
varPersNr = .Cells(Zeile, 6).Text
iCount = 1
dblSumme = .Cells(Zeile, 10)
Else
iCount = iCount + 1
dblSumme = dblSumme + .Cells(Zeile, 10)
End If
Next
End With
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Doppelte Einträgen Suchen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread