koşullu veri alma

[chakistes]

merhaba arkadaşlar excelde sayfa 1 de a sütunundan c sütununa belirli kritere göre verileri almak istiyorum örnek olarak kırmızı olarak işaretlediğim 1 rakam 2 rakam ve 3 rakam ile başlayıp nokta olan ip adresi gibi olanları c sütununa aktarmak istiyorum
örnek olarak
83.48.46.124
2019228.491
2018142.645
2017112.204
1.12.23.44.55
201659.228
123.45.56.77.11
201559.150
time2020-05-31 19:33
time2020-05-31 19:27
27.3.123.108

 

[ÖmerFaruk]

Sub IPAdresGibiler()
    'IP adresleri içeriğinde 3 nokta olması ve tamamen numeric ifadeler yer alması koşulundan yola çıkarak
    j = 1
    'Satırlarınız A2 den başladı varsaydım
    Son = Range("A2").End(xlDown).Row
    For i = 2 To Son
    If Len(Cells(i, 1)) - Len(Replace(Cells(i, 1), ".", "")) <> 3 Then GoTo Atla
    C = Split(Cells(i, 1), ".")
    For k = 0 To UBound(C)
        If Not IsNumeric(C(k) * 1) Then GoTo Atla
    Next k
    j = j + 1
    Range("C" & j) = Cells(i, 1)
Atla:
    Next i
End Sub

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub ip()
sonA = Cells(Rows.Count, "A").End(3).Row
c = 1
For i = 1 To sonA
    For j = 2 To 4
        If Mid(Cells(i, "A"), j, 1) = "." Then
            Cells(c, "C") = Cells(i, "A")
            c = c + 1
            j = 4
        End If
    Next
Next
End Sub

 

[muratboz06]

Ekte iki farklı çözüm var; Fonksiyon olanı kullanmanızı tavsiye ederim.
A sütununa verileri kopylayıp, B ve C sütunundaki formülleri aşağı doğru kopyalayabilirsiniz.

IpAdresiKontrolEt.xlsm dosyasını indir - download

IpAdresiKontrolEt.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s4.dosya.tc

Ayrıca 123.45.56.77.11 geçerli bir ip adresi değildir.

 

[chakistes]

teşekkür ederim denedim tam istediğim gibi

 

[Haluk]

"Regular Expressions" ile alternatif makro:

Sub Test()
'   Haluk - 31/05/2020
'   sa4truss@gmail.com
'
    Dim regExp As Object
    Dim myStr As String, i As Byte, x As Byte
    
    Range("C1:C" & Rows.Count) = ""
    
    Set regExp = CreateObject("VBScript.RegExp")
    
    regExp.Pattern = "(^[0-9]{2,3}\.).+"
    
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 1 To NoA
        myStr = Range("A" & i)
        If regExp.Test(myStr) Then
            x = x + 1
            Range("C" & x) = myStr
        End If
    Next
    
    Set regExp = Nothing
End Sub

.

 

[chakistes]

son bir sorum olacak aşağıdaki kodla istediğim gibi alıyor fakat binlik ayırıcısı olanları almadı normal ip gibi onlarıda almak istiyorum.
Sub ip()
sonA = Cells(Rows.Count, "A").End(3).Row
c = 1
For i = 1 To sonA
For j = 2 To 4
If Mid(Cells(i, "A"), j, 1) = "." Then
Cells(c, "C") = Cells(i, "A")
c = c + 1
j = 4
End If
Next
Next
End Sub

ekledim.

 

[Haluk]

Aşağıdaki kırmızı ilaveyi yapıp, deneyin ...

myStr = Range("A" & i).Text

.

 

[Erdem Akdemir]

1.12.23.44.55 neden hariç. Olmasını istediğiniz örneklerden farkı nedir?
Soru noktalar üzerine ama mesajda hiç noktalama işareti yok.

 

[chakistes]

1.12.23.44.55 bunu örnek olarak yazmıştım ama aşağıdaki kod oldu yanlız
myStr = Range("A" & i).Text bu kodu nasıl buraya uyarlama yapabilirim



sonA = Cells(Rows.Count, "A").End(3).Row
c = 1
For i = 1 To sonA
For j = 2 To 4
If Mid(Cells(i, "A"), j, 1) = "." Then
Cells(c, "C") = Cells(i, "A")
c = c + 1
j = 4
End If
Next
Next

 

[YUSUF44]

Tam çözüm mü emin değilim ama deneyiniz:

Sub ip()
sonA = Cells(Rows.Count, "A").End(3).Row
c = 1
For i = 1 To sonA
    If IsNumeric(Cells(i, "A")) = True Then
        Cells(c, "C") = Cells(i, "A")
        c = c + 1
    Else
        For j = 2 To 4
            If Mid(Cells(i, "A"), j, 1) = "." Then
                Cells(c, "C") = Cells(i, "A")
                c = c + 1
                j = 4
            End If
        Next
    End If
Next
End Sub

 

[chakistes]

merhaba userform içinde kodu ekledim fakat normal nokta ile ayrılan sayıları aktarıyor binlik ayırıcısı olanları aktarmıyor.

 

[YUSUF44]

Userfroma neden ihtiyaç duıydunuz bilmiyorum, sayfaya bir düğme ekleyerek de yapabilirdiniz ama sorununuz userformda hala bir önceki kodların olması.

 

[chakistes]

merhaba öncelikle ilgilendiğin için teşekkür ederim userformda başka kullandığım program için entegre edeceğim.