DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Kusura bakmayın farketmemişim.Bizim köyde konuşmaya ya da soru sormaya Merhaba, İyi günler gibi sözcüklerle başlanır.
Sizin köyde doğrudan mahabbet olayı herhalde
Örnek dosyanızı paylaşım sitelerinden birine yükleyin.
Sub IP_Bul()
Set s1 = Sheets("Sayfa2")
ss = s1.Cells(Rows.Count, "C").End(3).Row
myArr = s1.Range("C2:C" & ss)
s1.Range("D2:D" & s1.Cells(Rows.Count, "C").End(3).Row).ClearContents
myIP = Left(myArr(1, 1), 12)
Sat = 2
Set myList = CreateObject("System.Collections.ArrayList")
For i = 1 To UBound(myArr)
If Not myList.Contains(myArr(i, 1)) Then myList.Add myArr(i, 1)
Next
For k = 1 To 254
If Len(k) < 2 Then y = "00" & k
If Len(k) = 2 Then y = "0" & k
If Len(k) = 3 Then y = k
yx = myIP & y
If Not myList.Contains(yx) Then
s1.Cells(Sat, 4) = yx
Sat = Sat + 1
End If
Next k
End Sub
Sub test()
Dim veri, i, ii, bl, ilkP, say1, say2, v
With Sheets("Sayfa1")
veri = .Range("G2:J" & .Cells(Rows.Count, "A").End(3).Row).Value
End With
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(veri)
For ii = 1 To 4 Step 3
v = veri(i, ii)
If v <> "" And IsNumeric(v) And _
Len(v) - Len(Replace(v, ".", "")) = 3 Then
bl = Split(StrReverse(v), ".", 2)
bl(0) = StrReverse(bl(0))
bl(1) = StrReverse(bl(1))
If ilkP = "" Then ilkP = bl(1)
If ilkP = bl(1) Then .Item(Val(bl(0))) = Null
End If
Next ii
Next i
Sheets("Sayfa1").Range("M:N").ClearContents
For i = 1 To 254
If .exists(i) Then
say1 = say1 + 1
Sheets("Sayfa1").Range("M" & say1).Value = ilkP & "." & i
Else
say2 = say2 + 1
Sheets("Sayfa1").Range("N" & say2).Value = ilkP & "." & i
End If
Next i
End With
End Sub