Dizilerde ki Benzersiz Değerleri Elde Etme

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.

Paylaşmayı unutmayın!
5 1 vote
Article Rating
Subscribe
Bildir
guest
0 Yorum
Inline Feedbacks
View all comments