8
0
2024-11-08 15:39:19 +01:00

52 lines
1.6 KiB
Plaintext

' RemoveDuplicatesFromArray(arrItems : Array)
' ----------------------------------------------------------------------------
' Entfernt doppelte Einträge aus Ein-Dimensionalen Arrays
'
' Source: https://devblogs.microsoft.com/scripting/how-can-i-delete-duplicate-items-from-an-array/
'
' Returns: RemoveDuplicatesFromArray : Array
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 10.08.2020 / MK
' Version Date / Editor: 10.08.2020 / MK
' Version Number: 1.0.0.0
Function RemoveDuplicatesFromArray(arrItems)
If (Ubound(arrItems) >= 0) Then
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Array count: " & (Ubound(arrItems)+1),,"DEBUG - Info: BEFORE deduplication!"
End If
Set objDictionary = CreateObject("Scripting.Dictionary")
For Each strItem in arrItems
If Not objDictionary.Exists(strItem) Then
objDictionary.Add strItem, strItem
End If
Next
intItems = objDictionary.Count - 1
ReDim arrItems(intItems)
i = 0
For Each strKey in objDictionary.Keys
arrItems(i) = strKey
i = i + 1
Next
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Array count: " & (Ubound(arrItems)+1),,"DEBUG - Info: AFTER deduplication!"
End If
End If
RemoveDuplicatesFromArray = arrItems
End Function