Zahl bei doppelten Einträgen erhöhen?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
dann probier mal dieses Makro.
um das zu verstehen, sind allerdings schon fortgeschrittene Kenntnisse erforderlich (Dictionary-Objekt)

Sub test()
Dim dicMax As Object
Dim dicDup As Object
Dim arrK, arrU
Dim rngK As Range, rngU As Range
Dim z As Long
Dim ID As String
Set dicMax = CreateObject("scripting.dictionary")
Set dicDup = CreateObject("scripting.dictionary")
Set rngK = Range(Cells(5, "K"), Cells(5, "K").End(xlDown))
Set rngU = rngK.Offset(0, 10)
arrK = rngK.Value
arrU = rngU.Value
For z = 1 To UBound(arrK, 1)
If Len(arrK(z, 1)) = 16 Then
If CLng(arrU(z, 1)) > dicMax(arrK(z, 1)) Then dicMax(arrK(z, 1)) = CLng(arrU(z, 1))
End If
arrU(z, 1) = "'" & arrU(z, 1)
Next
For z = 1 To UBound(arrK, 1)
If Len(arrK(z, 1)) = 16 Then
ID = arrK(z, 1) & "-" & arrU(z, 1)
If dicDup.exists(ID) Then
dicMax(arrK(z, 1)) = dicMax(arrK(z, 1)) + 1
arrU(z, 1) = "'" & Format(dicMax(arrK(z, 1)), "000")
End If
dicDup(ID) = dicDup(ID) + 1
End If
Next
rngU.Offset(0, 1).Value = arrU
End Sub

Teste mal obs tut, zu kontrollzwecken wird der wert in Spalte U nicht überschrieben sondern das Ergebnis wird in die Nachbarspalte eingefügt.
Wenns passt, kannst du ja in der letzten Zeile das OFFSET löschen.
Gruß Daniel

Moin Sergej,
ich sage es mal ganz vorsichtig: Du willst eine VBA-Lösung, bietest aber NULL Eigenleistung in Form eines grundsätzlichen Codes wo Helfer gezielt ergänzen oder korrigieren können. Das würde ja bedeuten, dass du eine Komplettlösung haben willst? ☹
Dazu kommt dann noch, dass ich nicht verstehe, was du mit "dann soll der Eintrag in Spalte U um nächsten freien Zahl vom Doppelgänger erhöht werden" meinst. Da fehlt das eine oder andere Muster-Ergebnis. Ich habe das einmal ohne VBA mit Power Query gelöst, stelle aber aus prinzipiellen Erwägungen nur mein Ergebnis vor: => https://pchilfenord-my.sharepoint.com/:x:/g/personal/g_mumme_pc-hilfe-nord_de/EY98lM_AK4hBiakvgvY5vZYBGPnA5MF1BxdZF1ajddA_Yw?e=MVuLbU (eventuell Rechtsklick)

Gruß
Günther | mein Excel-Blog
-.-.-.-

Da ich mich nicht mehr über den "eigenwilligen" Hindernislauf beim Foren-Upload ärgern will, stelle ich meine Uploads hier nur noch in meiner MS-Cloud zur Verfügung. Den Link findest du im Beitrags-Text. Abrufe sind natürlich freiwillig und werden selbstredend nicht ausgewertet.

Beliebteste Forumthreads (12 Monate)

Zahl bei doppelten Einträgen erhöhen?

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread