EXCEL Makro; Doppelte Einträge mit spezieller Bedingung löschen

Guten Morgen @ ALL,

ich habe mal wieder ein Programmieraufgabe für Euch, die sich für mich als Laie auf diesem Gebiet zu schwierig gestaltet.
Es handelt sich um eine Splate B in der z.B. Artikelnummern stehen und eine Spalte C in der die Häufigkeit dieses Artikels steht.

BSP:
Spalte A
012255
012336
012255
012255
012889

Spalte C
12
6
5
3
10

Spalte M
2
5
1
0
5

Ich benötige ein Makro, dass mir in der kompletten Splate B nach doppelten Einträgen sucht. (soweit habe ich das auch)

Die Bedingungen:
*Suche nur nach einträgen die keine Hintergrundfarbe haben, bzw. weiß als Hintergrundfarbe haben.
*Suche zudem in Spalte C, bei den doppelten Eintragen nach der Zahl und addiere diese alle zusammen
*lösche die doppelten Einträge, bei denen in Spalte M die kleinere Zahl steht.
*Trage die Summe der Zahlen aus Spalte C bei dem NICHT gelöschtem Eintrag ein.

D.h. hier im Beispiel:
Spalte A
012255
012336
012889

Spalte C
20
6
10

Spalte M
2
5
5


Ich hoffe es kann mir zumindest einer hier im Forum helfen

 

Ich würde wie folgt vorgehen:

1. Daten nach Spalte C sortieren.

2. Nun ab der zweiten Zeile der Liste jeweils die Zelle mit der darüberliegenden vergleichen. Wenn "gleich" dann Zeile löschen, sonst zur nächsten Zeile gehen.

Gruss
Bruno

 

Ich habe jetzt ein Makro, das eigentlich auch alles macht was ich mir vorstelle.

Ich würde aber gerne noch die Summe der Duplikate in Spalte M durch 2 dividieren.

ich habe das auch schon versucht, doch das ergebnis stimmt nicht.
vielleicht hat jemand eine Idee ?

Ich habe die entsprechende Stelle im Code grün eingefärbt

Code:

Sub Mog()
Dim OjDicOrg As Object, OjDicDub As Object
Dim Bereich As Range, Zelle As Range, HilfsArray() As Variant
Dim I As Long

Set OjDicOrg = CreateObject("Scripting.Dictionary")
Set OjDicDub = CreateObject("Scripting.Dictionary")

Set Bereich = Range("B1:B" & Range("B500").End(xlUp).Row)

For Each Zelle In Bereich
    If OjDicOrg.Exists(Zelle.Text) = False Then
        OjDicOrg.Add Zelle.Text, Zelle.Row
    Else
        OjDicDub.Add Zelle.Row, OjDicOrg(Zelle.Text)
    End If
Next Zelle


'2 Bereiche:
'OjDicOrg enthält alle einmaligen Zeilen und
'OjDicDub enthält alle Dubletten
' das Ergebnis kann man auswerten


HilfsArray = OjDicDub.Keys
For I = UBound(HilfsArray) To 0 Step -1
    
    'alle Dubletten werden markiert
    Rows(HilfsArray(I)).Interior.ColorIndex = 3
    
    'die Addition durchgeführt
    Range("C" & OjDicDub.Item(HilfsArray(I))).Value = _
    Range("C" & OjDicDub.Item(HilfsArray(I))).Value + _
    Range("C" & HilfsArray(I)).Value
    
[COLOR="SeaGreen"]
    Range("M" & OjDicDub.Item(HilfsArray(I))).Value = _
    Range("M" & OjDicDub.Item(HilfsArray(I))).Value + _
    Range("M" & HilfsArray(I)).Value[COLOR="Red"] / 2[/COLOR] [/COLOR]
    
    'Hier werden alle Dubletten gelöscht
    Rows(HilfsArray(I)).Delete
Next I

End Sub

 

Wahrscheinlich musst Du eine Klammer () um die beiden Summanden machen... ;-)

Gruss
Bruno

 

ich habe da schon sämtliche variationen versucht ;-)

gruß zurück

 

Welche Zahlen hast Du, die zusammengezählt werden sollen? Welches Resultat gibt es zurück und welches sollte zurückgegeben werden?

Gruss
Bruno

 

also ich habe ein Bsp mit 4 gleichen Zahlen in Spalte A

in Splate M befindet sich
2
8
6
12
= 28 / 2 = 14 für Spalte M

ich habe dann das Makro so wie gepostet ausgeführt und erhalte dann in Spalte A einmal die Zahl und in Spalte M eine 15. das wäre nur 1 zu viel.

Dann habe ich im Makro die ".../ 2" in "..../2 -1" geändert. da punkt vor strich müsste eigentlich 14 rauskommen. es kommt aber 12 raus.

und so ging es mir mit allen variationen :-(

Gruß

 

Code:

    Range("M" & OjDicDub.Item(HilfsArray(I))).Value = _
    [COLOR="SeaGreen"]([/COLOR]Range("M" & OjDicDub.Item(HilfsArray(I))).Value + _
    Range("M" & HilfsArray(I)).Value[COLOR="seagreen"])[/COLOR] / 2 

Du hast zwar gesagt, Du hättest es schon mit Klammern versucht. Aber wahrscheinlich nicht mit dieser Variante...

Gruss
Bruno

 

Danke erstmal für deinen Einsatz :-)

Du hast recht, die Variante habe ich noch nicht versucht!

Ich bekomme jetzt aber als Ergebnis "7", es sollte aber 14 rauskommen.
hänge ich an die /2 noch *2, dann bekomme ich 28.

???

Gruß

 

Oh ja, stimmt! Wir rechnen nicht die Hälfte von allen. Der bisherige Wert wird immer wieder durch 2 geteilt...

Du kannst aber einfach den Wert, der in der Addition vorher berechnet wird, durch 2 teilen.

Gruss
Bruno

PS: Müsstest Du nicht den Durchschnitt aller Zahlen berechen? Also durch die Anzahl Zahlen?

 

Nein der Mittelwert bringt mir in der Spalte M nichts, da er für das Ergebnis wofür die Spalte später bestimmt ist nichts bringt.

Wie meinst du das, in der addition davor?

Gruß

 

Das!

Gruss
Bruno

 

ja ok...aber in spalte C möchte ich dir Werte nicht teilen.

 

Aber es handelt sich bei diesem Total um die "28", die Du für die Spalte M durch 2 teilen willst, oder?

Gruss
Bruno

 

ja...es handelt sich um die 28.

gruß