Module: Reorg / Cleanup

archive/Modules/Sicherungen/Modules_20230623/RemoveDuplicatesFromArray.vbs

@@ -0,0 +1,52 @@
+' 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