Anzeige
Archiv - Navigation
1360to1364
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

Duplikate mit Abhängigkeit. einer weiteren Spalte

Duplikate mit Abhängigkeit. einer weiteren Spalte
23.05.2014 12:07:16
Christopher
Servus Leute,
evtl. hat am Weekend mal einer Zeit. Irgendwie klappt es nicht dass er die Duplikate nur aufzählt wenn in der 19. Spalte bei beiden Duplikaten "Belegt" steht. Ich glaub ich habs mir zu leicht gemacht. Keine Idee mehr ...
Danke und schönes Wochenende.!!!
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A2500")) Is Nothing Then
Dim lrow As Long
Dim LoI As Long
Dim Zeile As Integer
Dim Meldung As String
lrow = Cells(Rows.Count, 1).End(xlUp).Row
For LoI = 2 To lrow
If Cells(LoI, 2)  "" Then
If Application.CountIf(Range("B2:B" & lrow), Cells(LoI, 2)) > 1 And Cells(LoI, 19)  "Belegt" Then 'Hier klappts nicht so wie es soll
Meldung = Meldung & Cells(LoI, 1) & vbCrLf
End If
End If
Next LoI
MsgBox Meldung
End If
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Duplikate mit Abhängigkeit. einer weiteren Spalte
23.05.2014 15:10:54
Tino
Hallo,
habe es mal so mit einer Hilfsspalte versucht.
Wenn dies nicht geht, müssen wir was anderes versuchen.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Meldung As String
Dim rng As Range, MaxRow&, rngTrue As Range

If Not Intersect(Target, Range("A2:A2500")) Is Nothing Then
    MaxRow = Cells(Rows.Count, 2).End(xlUp).Row
    If MaxRow > 1 Then
        Application.EnableEvents = False
        
        If MaxRow > 2500 Then MaxRow = 2500
        
        Set rng = Range("A2:A" & MaxRow).Offset(, Me.UsedRange.Columns.Count + 1)
        
        rng.FormulaR1C1 = _
        "=IF(SUMPRODUCT((R2C2:R" & MaxRow & "C2&R2C19:R" & MaxRow & "C19=RC2&""Belegt"")*1)>1,TRUE,"""")"
        
        On Error Resume Next
        Set rngTrue = rng.SpecialCells(xlCellTypeFormulas, 4)
        If Not rngTrue Is Nothing Then
            For Each rngTrue In rngTrue.Cells
                Meldung = Meldung & Cells(rngTrue.Row, 1) & vbCr
            Next rngTrue
        End If
        
        rng.EntireColumn.Delete
        
        Application.EnableEvents = True
    End If
End If
If Meldung <> "" Then
    MsgBox Left$(Meldung, Len(Meldung) - 1)
End If
End Sub
Gruß Tino

Anzeige
AW: Duplikate mit Abhängigkeit. einer weiteren Spalte
27.05.2014 08:20:32
Christopher
An ne Hilfsspalte hab ich noch garnicht gedacht O.o
Ich try das mal so. Denke das bekomm ich hin. Vielen Dank und schöne Woche Euch !!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige