Рет қаралды 1,153
DİCTİONARY KULLANARAK İKİ LİSTEYİ BİRBİRLERİ İÇERİSİNDE KARŞILAŞTIRABİLİRSİNİZ. BU KOD SAYESİNDE İSE BUNU WİNDOWS NATİVE OBJESİ OLAN DİCTİONARY İLE EN HIZLI ŞEKİLDE YAPABİLİRSİNİZ.
Option Explicit
Public Enum KarsilastirmaTuru
SadeceListe1 = 1
SadeceListe2 = 2
HerIkiside = 3
End Enum
Public Sub ListeKarsilastirmasi()
'Tanimlamalar
'----------------------------------
Dim ws As Worksheet
Set ws = Sheet1
Dim rngListe1 As Range
Dim rngListe2 As Range
Dim rngSonuc As Range
Set rngListe1 = ws.Range("A1").CurrentRegion
Set rngListe2 = ws.Range("C1").CurrentRegion
Set rngSonuc = ws.Range("E1").CurrentRegion
Dim karsilastirma As KarsilastirmaTuru
karsilastirma = HerIkiside
'----------------------------------
Dim dictListe1 As New Dictionary
Dim dictSonuc As New Dictionary
Set dictListe1 = ListeyiOku(rngListe1.Value2)
Set dictSonuc = ListeleriKarsilastir(dictListe1, _
rngListe2.Value2, karsilastirma)
SonuclariYaz rngSonuc, dictSonuc
MsgBox "Listeler Karsilastirilmistir", _
vbInformation, "Sayin " & Environ("UserName")
End Sub
Private Sub SonuclariYaz(ByVal inpRng As Range, ByVal inpDict As Dictionary)
With inpRng
.CurrentRegion.ClearContents
.Value2 = "Sonuclar"
.Offset(1, 0).Resize(inpDict.Count, 1).Value2 = _
Application.Transpose(inpDict.Keys)
End With
End Sub
Private Function ListeleriKarsilastir(ByVal inpDict As Dictionary, _
ByVal inpArr As Variant, _
ByVal karsilastirma As KarsilastirmaTuru) As Dictionary
Dim i As Long
Dim item As Variant
Dim dictKarsilastirmaSonuc As New Dictionary
Dim dictSadeceListe2 As New Dictionary
For i = LBound(inpArr, 1) To UBound(inpArr, 1)
item = inpArr(i, 1)
If inpDict.Exists(item) = True Then
dictKarsilastirmaSonuc(item) = 0
inpDict.Remove item
Else
dictSadeceListe2(item) = 0
End If
Next i
If karsilastirma = HerIkiside Then
Set ListeleriKarsilastir = dictKarsilastirmaSonuc
ElseIf karsilastirma = SadeceListe1 Then
Set ListeleriKarsilastir = inpDict
ElseIf karsilastirma = SadeceListe2 Then
Set ListeleriKarsilastir = dictSadeceListe2
End If
End Function
Private Function ListeyiOku(ByVal inpArr As Variant) As Dictionary
Dim i As Long
Dim dict As New Dictionary
For i = LBound(inpArr, 1) To UBound(inpArr, 1)
dict(inpArr(i, 1)) = 0
Next i
Set ListeyiOku = dict
End Function