VisualBasic Excel VBA, Range Zuordnung will nicht

[Cassius1985]

Hi Leute,

ich sitz mal wieder vor einer Wand, die Lösung mit Sicherheit zum Greifen nah und komm nicht drauf

Ich versuche doppelte Werte in einem Bereich automatisch löschen zu lassen, bis auf einen kleinen Bereich in diesem Bereich.
Quasi das kleine gallische Dorf unter der Besetzung Cäsars...

Das ist der Code:

Sub doppelte()
Dim zelle As Range
Dim bereich As Range
Set bereich = Tabelle4.Range("A1:H36")

For Each zelle In bereich


If WorksheetFunction.CountIf(bereich, zelle.Value) > 1 Then
zelle.Value = ""
ElseIf zelle.Interior.ColorIndex = 16 Then
zelle.Value = ""
Else

End If
Next zelle

End Sub

Der Bereich der davon eigentlich NICHT betroffen sein soll, ist A3 bis H3 sowie A10 bis H10, ODER A25:B36 (Denn da dürfen doppelte Werte stehen.

Wenn ich versuche den Bereich im Range so zu erfassen : Set bereich = Tabelle4.Range("A5:H8, A12:H15, D18: D36") bekomme ich den Fehler: "Laufzeitfehler 1004: Der CountIf-Eigenschaft des WorksheetFunction-Objektes kann nicht zugeordnet werden."

Was auch ginge:

Den Bereich D18: D36 mit A5: H15 abgleichen und die doppelten in Bereich A5: H15 löschen.


Danke

 

[Janush]

Versuchs doch mal mit intersect und definiere die drei ausschluss bereiche als union. Ungefähr sowas wie if intersect zelle mit union(bereich1 2 3).

Bin grade nur am Handy...müsse morgen früh mal genauer nachschauen

 

[Cassius1985]

Hab ich versucht, das mag CountIf nicht :/

Habs jetzt so gelöst, dass ich die Daten aus Bereich A25:B36 vor dem Löschen aus dem Bereich kopiere und später wieder einfüge...

 

[Janush]

Achso, du meinst in diesem kleinen Bereich darf nicht nur nicht gelöscht werden, sondern die Werte dürfen auch nicht zur Zählung der Doppelungen herangezogen werden?

Oder Zählen ja, aber nicht löschen?

Und wenn ein Wert doppelt vorkommt, wie wird entschieden welcher der Werte gelöscht wird, oder geht das nach first come first serve?

 

[Cassius1985]

Ja genau, der Bereich muss ausgeklammert werden, weder gezählt noch gelöscht.

Der doppelte Wert der zuerst auftritt, wird gelöscht, von oben links nach unten rechts.
Das funktinioniert ansich auch prima

 

[Janush]

Auch wenn du es schon schön gelöst hast, hier nochmal ein anderer Ansatz. Du hast Recht, countif funktioniert nicht über mehrere Bereiche, deshalb bauen wir einfach unsere eigene Funktion dafür.

Hier mal dein Code etwas erweitert.

Sub doppelte()
Dim zelle    As Range
Dim bereich  As Range

Dim bereichA As Range
Dim bereichB As Range
Dim bereichC As Range
Dim bereichD As Range

With Tabelle4

    Set bereichA = .Range("A1:H2")
    Set bereichB = .Range("A4:H9")
    Set bereichC = .Range("A11:H24")
    Set bereichD = .Range("C25:H36")
    
    Set bereich = Union(bereichA, bereichB, bereichC, bereichD)
    
End With

For Each zelle In bereich

    If AnzahlWertInBereich(bereich, zelle.Value) > 1 Then
        zelle.Value = ""
    ElseIf zelle.Interior.ColorIndex = 16 Then
        zelle.Value = ""
    Else

    End If
    
Next zelle

End Sub

Private Function AnzahlWertInBereich(ByRef bereich As Range, ByVal wert As Variant)

Dim anzahl As Integer
Dim zelle  As Range

For Each zelle In bereich

    If zelle.Value = wert Then anzahl = anzahl + 1

Next zelle

AnzahlWertInBereich = anzahl

End Function

Ich habe hier den zu überprüfenden Bereich über eine Union zusammengebastelt und lasse da dann die neue CountIf Funktion drüberlaufen.

Vielleicht hilfts ja jemanden :-)

 

[Cassius1985]

Super Ansatz! Werde ich auf jeden Fall mal einbauen und testen