dosyam ektedir ilglenen arkadaşlara şimdiden tşk.
Ekli dosyalar
-
45 KB Görüntüleme: 18
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub listele()
Dim i As Long, sat1 As Long, sat2 As Long, sat3 As Long
Sheets("Sayfa2").Select
Application.ScreenUpdating = False
Range("A3:K65536").ClearContents
sat1 = 3: sat2 = 3: sat3 = 3
With Sheets("Sayfa1 (2)")
For i = 3 To .Cells(65536, "A").End(xlUp).Row
For k = 3 To .Cells(65536, "B").End(xlUp).Row
If .Cells(i, "A").Value = .Cells(k, "E").Value And _
UCase(Replace(Replace(.Cells(i, "B").Value, "ı", "I"), "i", "İ")) = _
UCase(Replace(Replace(.Cells(k, "F").Value, "ı", "I"), "i", "İ")) Then
Range(Cells(sat1, "A"), Cells(sat1, "C")).Value = _
.Range(.Cells(i, "A"), .Cells(i, "C")).Value
sat1 = sat1 + 1
End If
If .Cells(i, "A").Value = .Cells(k, "E").Value And _
UCase(Replace(Replace(.Cells(i, "B").Value, "ı", "I"), "i", "İ")) <> _
UCase(Replace(Replace(.Cells(k, "F").Value, "ı", "I"), "i", "İ")) Then
Range(Cells(sat2, "E"), Cells(sat2, "G")).Value = _
.Range(.Cells(i, "A"), .Cells(i, "C")).Value
sat2 = sat2 + 1
End If
If .Cells(i, "A").Value <> .Cells(k, "E").Value And _
UCase(Replace(Replace(.Cells(i, "B").Value, "ı", "I"), "i", "İ")) = _
.Cells(i, "F").Value Then
Range(Cells(sat3, "I"), Cells(sat3, "K")).Value = _
.Range(.Cells(i, "A"), .Cells(i, "C")).Value
sat3 = sat3 + 1
End If
Next k
Next i
End With
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır..!!", vbOKOnly
End Sub
Rica ederim.evren bey görünmez kaza olmuş , emeğinize teşekkürler ii akşamlar.