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
Негізгі бет KOD AÇIKLAMADA - DİCTİONARY İLE İKİ LİSTEYİ KARŞILAŞTIRMA - EN HIZLI YÖNTEM
Пікірлер: 36