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…
İlk Yorumu Siz Yapın