DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub prmts()
SAY = 1
For i = 2 To Range("a65536").End(3).Row
Range("ee" & i).Value = Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value
Next i
For K = Range("a65536").End(3).Row To 2 Step -1
If WorksheetFunction.CountIf(Range("eE:eE"), Range("ee" & K).Value) > 1 Then
SAY = SAY + 1
Sheets("KONTROL").Range("A" & SAY).Value = Cells(K, 4).Value
Sheets("KONTROL").Range("B" & SAY).Value = Cells(K, 5).Value
Sheets("KONTROL").Range("C" & SAY).Value = Cells(K, 6).Value
End If
Range("ee" & K).Value = ""
Next K
End SubSub Ayni_Olanlar()
Dim i As Long, _
j As Long, _
Deg As Variant, _
s2 As Worksheet, _
sk As Worksheet, _
a1, _
a2, _
d, _
s
Set s2 = Sheets("Sayfa2")
Set sk = Sheets("KONTROL")
s2.Select
j = sk.Cells(Rows.Count, "A").End(3).Row
If j < 2 Then j = 2
sk.Range("A2:D" & j).ClearContents
j = 1
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To Cells(Rows.Count, "A").End(3).Row
Deg = Cells(i, "D") & "|" & Cells(i, "E") & "|" & Trim(Cells(i, "F"))
If Not d.exists(Deg) Then
d.Add Deg, 1
Else
d.Item(Deg) = d.Item(Deg) + 1
End If
Next i
a1 = d.keys
a2 = d.items
For i = 0 To d.Count - 1
If a2(i) > 1 Then
s = Split(a1(i), "|")
j = j + 1
sk.Cells(j, "A") = s(0)
sk.Cells(j, "B") = s(1)
sk.Cells(j, "C") = s(2)
sk.Cells(j, "D") = a2(i)
End If
Next i
End Sub
Sub prmts()
Dim i As Long, dfg As Long, k As Long
For i = 2 To Range("a65536").End(3).Row
If WorksheetFunction.CountIf(Range("eE:eE"), Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value) > 0 Then
Else
dfg = dfg + 1
Range("ee" & dfg).Value = i
End If
Next i
For k = 2 To Range("ee65536").End(3).Row
Sheets("KONTROL").Range("A" & k).Value = Cells(Cells(k, "ee").Value, 4).Value
Sheets("KONTROL").Range("B" & k).Value = Cells(Cells(k, "ee").Value, 5).Value
Sheets("KONTROL").Range("C" & k).Value = Cells(Cells(k, "ee").Value, 6).Value
Range("ee" & k).Value = ""
Next k
End Sub