Bir projemde dizinin içinde ki değerlerden benzersiz olanları elde etmem gerekiyordu. Aşağıda kodlarını paylaşacağım çözüm işime bir hayli yaramıştı. İçinde tüm değerlerin olduğu diziyi başka bir dizi içine benzersiz değerler olacak şekilde atabildim. Umarım sizin de işinize yarar.
Sub GtipGetir() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim arr As New Collection, a Dim aFirstArray() As String Dim dolu As Integer Set ws1 = Sheets("KNÇ") Set ws2 = Sheets("LG") Set ws3 = Sheets("PR") ws1.Range("d31:j37") = "" For i = 1 To 40 If ws3.Range("R" & i + 13) <> "" Then dolu = dolu + 1 End If Next If dolu = 0 Then Exit Sub End If ReDim aFirstArray(dolu - 1) For j = 1 To 2 For i = 1 To dolu aFirstArray(i - 1) = WorksheetFunction.VLookup(Left(ws3.Range("R" & i + 13), 4), ws2.Range("B:E"), j + 2, False) Next On Error Resume Next Set arr = Nothing For Each a In aFirstArray arr.Add a, a Next For i = 1 To arr.Count If j = 2 Then j = 6 End If ws1.Cells(i + 30, j + 4) = arr(i) Next Next For i = 1 To arr.Count ws1.Range("d" & i + 30) = WorksheetFunction.VLookup(arr(i), ws2.Range("E:F"), 2, False) Next End Sub
Bu kodlarda ki kilit nokta;
For Each a In aFirstArray arr.Add a, a Next
tamamen burası. Konumuzun kahramanı aslında burası. Diğer kodlar çokta önemli değil şu an için. Bütünlüğü bozmasın diye kodların hepsini paylaştım.
Kolay gele.