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.
drive.google.com
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