Belirli iki veriyi bulup ikinci veri altındaki belirli veriyi yazdırmak

[u.L.a.s]

Merhabalar

Sheet1 de A sütununda aşağıya doğru satır satır bir çok veri var.
Sheet2 de ise A sütununda bazı IP değerleri satır satır aşağıya doğru sıralıdır. Sheet2 de ayrıca B1-C1-D1-E1-F1 de yine belirli başlık verileri var.

Ben Sheet2 ye bu belirtilen başlıklar altına her satıra yanındaki IP değeri neyse Sheet1 de bulmasını. O Ip değerinin altında yine bulunduğu hücredeki sütun başlığınıda bulmasını istiyorum.

Bu sütun başlıkları ve IP değerleri Sheet1 de mutlaka var. Her IP değerinin altında bu sütun başlıkları olarak B1-C1-D1-E1-F1 belirttiğim değerlerin hepsi mevcut

Her IP için Sheet1 e gidip B1 deki sütun başlığı değerini bularak bu veri altında "switchport port-security" ibaresi varmı buna bakması gerekiyor.

Eğer bu "switchport port-security" değeri varsa sütun başlığı altına IP değeri karşısındaki hücreye bu değeri yazsın. Eğer bu veri yoksa "yok" şeklinde bir ibare yazsın.

Tabi bu sorgulamayı yaparken IP değerinin altına bakarken diğer bir IP değerine kadar bu sorgulamayı yapmalı. zira B sütunundaki değerler ve switchport port-security verisi zaten aşağıya doğru bir çok satırda var. önemli olan O IP kontorülünü yapması.

Bunun için bir ip nin kontrolünü "----------------------------------" en sonda böyle bir ayıraç mevcut oraya kadar yapabilir. bu ibareyi görünce o IP için sorgulamasını bitirir.

Örnek dosyamı aşağıdaki linkten indirebilir inceleybilirsiniz.
http://s9.dosya.tc/server/4bgqh7/Soru.rar.html

Engin bilgi ve değerli yardımlarınızı rica ederim.
Çok teşekkür ederim şimdidien




Sheet2 görüntüsü aşağıdaki gibidir.

 

[u.L.a.s]

Örnekleyerek anlatmam gerekirse;

Örneğin B2 hücresi sorgulama sonucunun yazılacağı bir hücre. Buraya yazacağı sonucu şu sorgulama sonrası yazması lazım.
Bağlı olduğu satırdaki IP değeri "10.10.10.10" ve bağlı olduğu sütundaki "interface FastEthernet0/1" verisini Sheet1 de arayacak. Sheet1 de bu IP değerinin alt satırlarında "interface FastEthernet0/1" değerini bulacak ve "interface FastEthernet0/1" verisinin bir kaç satır altında "switchport port-security" değerini görmeye çalışacak. eğer bu değer varsa B2 hücresine "switchport port-security" şeklinde veriyi yazacak. Eğer "switchport port-security" si yoksa B2 hücresine "yok" yazacak.
Bu şekilde C2-D2-E2-F2 ye de bu sorgulamayı yaparak ilgili sonucunu yazdıracak.
Sonra bir alt IP değerine geçerek B3-C3-D3-E3-F3 IP sini ve bağlı olduğu sütunlardaki FastEthernet0/x verisini bularak Fasthethernet verisi altındaki Switcport port-security değerini bulmaya çalışacak.

Burada önemli nokta ise şudur. Bu "switchport port-security" tek bir sütunda aşağıya doğru bir çok satırda mevcut. IP sorgulamasını 2. bir IP değerine kadar yapması lazım. bu sorgulamayı ise "----------------------------------" şeklindeki veri yazılı olan hücreyi görene kadar yapmalı. bu veriyi görünce o IP ile ilgili sorgulamasını bitirmeli zaten.

ikinci önemli nokta ise "interface FastEthernet0/1" verisinin sorgulamasını ""interface FastEthernet0/2" yi görünceye kadar yapmalı. yani her "interface FastEthernet0/x" verisi sorgulaması bir sonraki "interface FastEthernet0/x" sorgulamasına kadar olmalı.

 

[u.L.a.s]

Daha anlaşılır şekilde sorumu yineleyeyim.

Örneğin B2 hücresine HLOOKUP formülünü yazıyorsunuz ve A2 ve B1 deki değeri Sheet1 de sorgulatıp varsa getirtmeye çalışıyorsunuz gibi düşünelim. Burada tek farklı nokta B1 deki değerin alt satırında "switchport port-security" değeri varmı onu bulmak. varsa yazdırmak.

Bu sorum yapılabilir bir şey mi eğer yapılamayacak bir şeyse bunu belirtirseniz farklı bir sorgulama düşüneyim ona göre bir soru yönelteyim.

 

[Kardiyak]

Umarım istediğiniz şey olmuştur.
Kaç ip olduğu yada sheet1 in kaç satır olduğu fark etmez.
Yalnızca sheet2 de b1,c1,d1,e1,f1 hücrelerinde yazanlara bakar.


Herhangi bir modüle kopyalayıp çalıştırın.

Sub deneme()
Dim ipbak, ipbak2, tamam, boş As String
Dim dn, son1, son2 As Integer
Dim sh1, sh2 As Worksheet
Set sh1 = Sheets("Sheet1") [COLOR="SeaGreen"]'bakılacak liste sayfasının adı[/COLOR]
Set sh2 = Sheets("Sheet2") [COLOR="SeaGreen"]'yazılacak sayfanın adı[/COLOR]
son1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
son2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
tamam = " switchport port-security" [COLOR="SeaGreen"]'kontrol edilecek kelime[/COLOR]
boş = "YOK" [COLOR="SeaGreen"]'bulunmazsa yazılacak olan kelime[/COLOR]
Application.ScreenUpdating = 0
dn = 1
For ip = 2 To son2 [COLOR="SeaGreen"]'sheet2 deki ipleri sırayla kontrol et[/COLOR]
    ipbak = sh2.Range("A" & ip)
    ipbak2 = sh2.Range("A" & ip + 1)
    If ip = son2 Then ipbak2 = "BOŞ"
    ek = 0

dönf:
    For f = dn To son1 [COLOR="SeaGreen"]'sheet1 deki satırları sırayla kontrol et[/COLOR]
        If sh1.Range("A" & f) = "" Then
            dn = f + 1
            GoTo dönf
            End If
        If sh1.Range("A" & f) = ipbak Then
            dn = f + 1
            ek = 0
            GoTo dönf
            End If
        If sh1.Range("A" & f) = ipbak2 Then GoTo atlaip
        If sh1.Range("A" & f) = sh2.Range("B1").Offset(0, ek) Then
            dn = f + 1
            GoTo dönf
            End If
        If sh1.Range("A" & f) = sh2.Range("B1").Offset(0, ek + 1) Then
            ek = ek + 1
            dn = f + 1
            GoTo dönf
            End If
        If sh1.Range("A" & f) = tamam Then
            Range("B" & ip).Offset(0, ek) = tamam
            dn = f + 1
            GoTo dönf
            End If
    Next f
atlaip:
Next ip
For r = 2 To son2
    For c = 2 To 6
        If sh2.Cells(r, c) = "" Then sh2.Cells(r, c) = boş
    Next c
Next r
Application.ScreenUpdating = 1
MsgBox "Bitti.", vbInformation, "Tamamlandı"
End Sub

 

[u.L.a.s]

Üstadım emeğine bilgine sağlık denedim çok güzel çalışıyor makro.

Gerçi şu an örnek dosya üzerinde denedim. Örnek dosyada herhangi bir sorunla karşılaşmadım gayet güzel çalıştı

Diğer asıl dosya üstünde deneyip tekrar konuyla ilgili olumlu bilgi yazarım buraya.

Çok çok teşekkür ediyorum tekrardan.

 

[u.L.a.s]

Merhabalar

Genel listemde bu makroyu denedim.
Ufak bir sorun var.

Sheet2 de alta alta sıralanmış IP lerden örneğin 10. sıradaki ip bilgisini eğer Sheet1 de bulamazsa zaten O ip bilgisine bütün Fastethernetleri yok yazıp altındaki ip lerin karşısınada yok yazıp bitiriyor. yani eğer Sheet1 o ip yoksa onun altındaki ip lere bakmıyor.

Bilgi ve yardımlarınızı rica ederim

 

[u.L.a.s]

Kod düzeneğinde aşağıdaki gibi satırlar eklemeye çalıştım fakat eğer sheet2 de varolan ip yoksa o ip yi geçebilecek bir döngü yaratamadım

ipyok = sh2.Range("A" & ip)

If sh1.Range("A" & f) <> ipyok Then GoTo atlaip

 

[Kardiyak]

iç içe bir sürü for next olmaması için tek döngü içinde goto kullanmıştım. İp kontrolünü de "------------------" değerine kadar değil bir sonraki ip değerine kadar yapmıştım. Yani sorun ip'nin bulunamaması değil, sıradaki İp'nin olmaması. Arama bir sonraki ip'ye kadar devam ettiği için eğer sıradaki ip yoksa arama satırı sayfanın sonuna ulaşıyor. Bir sonraki döngüde artık sayfa sonuna gelindiği için değer bulunamıyor.
Diğer kodu silip aşağıdakini deneyin. Değişen satırlar kalın yazanlar.
(bu kod ile ilgili yaşanabilecek diğer bir sorun sheet1 deki ip sırasının sheet2 deki ile aynı olması gerekliliği. )

Sub deneme()
Dim ipk, ipbak, ipbak2, tamam, boş, bulunamadı As String
Dim dn, son1, son2 As Integer
Dim sh1, sh2 As Worksheet
Set sh1 = Sheets("Sheet1")[COLOR="Green"] 'bakılacak liste sayfasının adı[/COLOR]
Set sh2 = Sheets("Sheet2") [COLOR="Green"]'yazılacak sayfanın adı[/COLOR]
son1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
son2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
tamam = " switchport port-security" [COLOR="Green"]'kontrol edilecek kelime[/COLOR]
boş = "YOK" [COLOR="Green"]'interface bulunmazsa yazılacak olan kelime[/COLOR]
[B]bulunamadı = "YOK" [COLOR="Green"]'ip dökümde bulunmuyorsa yazacak kelime[/COLOR][/B]
Application.ScreenUpdating = 0
dn = 1
[B]sh2.Range("B2:F" & son2).ClearContents[/B]

[B]For ip0 = 2 To son2[COLOR="Green"] 'sheet2 deki ipler diğer sayfada varmı[/COLOR]
    ipk = sh2.Range("A" & ip0)
    Set varmı = sh1.Range("A1:A" & son1).Find(ipk, , xlValues, xlPart)
    If varmı Is Nothing Then
        MsgBox ip0 & ". satırdaki " & ipk & " verisi bulunamadı.", vbInformation, "UYARI" [COLOR="Green"]'bulunamayan ipler için uyarı bu satır silinebilir[/COLOR]
        sh2.Range("B" & ip0) = bulunamadı
    End If
Next ip0[/B]

For ip = 2 To son2 [COLOR="Green"]'sheet2 deki ipleri sırayla kontrol et[/COLOR]
[B]dönip:
    If sh2.Range("B" & ip) = bulunamadı Then ip = ip + 1: GoTo dönip[/B]
    ipbak = sh2.Range("A" & ip)
    ip2 = ip + 1
    
[B]dönip2:
    If sh2.Range("B" & ip2) = bulunamadı Then ip2 = ip2 + 1: GoTo dönip2[/B]
    ipbak2 = sh2.Range("A" & ip2)
    If ip = son2 Then ipbak2 = "BOŞ"
    ek = 0

dönf:
    For f = dn To son1 [COLOR="Green"]'sheet1 deki satırları sırayla kontrol et[/COLOR]
        If sh1.Range("A" & f) = "" Then
            dn = f + 1
            GoTo dönf
            End If
        If sh1.Range("A" & f) = ipbak Then
            dn = f + 1
            ek = 0
            GoTo dönf
            End If
        If sh1.Range("A" & f) = ipbak2 Then GoTo atlaip
        If sh1.Range("A" & f) = sh2.Range("B1").Offset(0, ek) Then
            dn = f + 1
            GoTo dönf
            End If
        If sh1.Range("A" & f) = sh2.Range("B1").Offset(0, ek + 1) Then
            ek = ek + 1
            dn = f + 1
            GoTo dönf
            End If
        If sh1.Range("A" & f) = tamam Then
            Range("B" & ip).Offset(0, ek) = tamam
            dn = f + 1
            GoTo dönf
            End If
    Next f
atlaip:
Next ip

For r = 2 To son2 [COLOR="Green"]' değer bulunamayan hücrelere boş değerini yazar.[/COLOR]
[B]dönr:
If sh2.Cells(r, 2) = bulunamadı Then r = r + 1: GoTo dönr[/B]
    For c = 2 To 6
        If sh2.Cells(r, c) = "" Then sh2.Cells(r, c) = boş
    Next c
Next r
Application.ScreenUpdating = 1
MsgBox "Bitti.", vbInformation, "Tamamlandı"
End Sub

 

[u.L.a.s]

Üstadım emeğinize sağlık. bende buraya bakıyordum sürekli.

şimdi kodu denedim. evet çalışıyor olmayan ip bilgisini atlıyor.


Ben txt dosyasından bu ip değerlerini getiriyorum. Bazı hücrelerde IP değeri 10.10.10.10 şeklinde olması gerekirken txt dosyasından veri satıra aktarılırken 10101010 şeklinde aktarılıyor. aslında her iki sheettede bu veri bu şekilde var ama arama yaparken hücrede görünen yazılı değer 10.10.10.10 u aradığı için bulamıyor.

bir önceki kodda bu sorun olmuyordu 10101010 şeklindede bulabiliyordu.



Başka bir makro kod düzeneği oluşturmamız daha mümkünmü. bu kod olacak ama öncesinde ben 10101010 olan arada nokta olmayan ip bilgilerini 10.10.10.10 haline getirebileyim. hem Sheet1 de hem sheet2 de bu düzeltmeyi yapıp bu son gönderdiğiniz kodla taramayı o şekilde yaptırayım.

Yani olursa tabi sizide uğraştırmak istemem. çok teşekkür ederim bu haliylede çok güzel

 

[Kardiyak]

Eğer istisnasız her ip verisi sonunda "----------------------------------" bulunuyorsa (en sonuncusunda olmasına gerek yok) aşağıdaki kod iplerin sıralı olması sorunu olmadan aynı işi yapar.

Sheet1'de nokta bulunmayan ip'lerin karşılaştırılması için kırmızı yazan kısımlar; sheet1'de noktasız olarak arama yapar. Eğer noktasız olarak bulursa sheet2 deki aranan değeri noktasız olarak tekrar yazar. Kodun geri kalan kısmı bu yeni ip listesine göre arama yapmaya devam eder.

Sub denemeeksili()
Dim ipk, ipbak, ipbak2, tamam, boş, bulunamadı As String
Dim dn, son1, son2, fes As Integer
Dim sh1, sh2 As Worksheet
Set sh1 = Sheets("Sheet1") 'bakılacak liste sayfasının adı
Set sh2 = Sheets("Sheet2") 'yazılacak sayfanın adı
son1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
son2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
fes = 5 'interface FastEthernet sütun sayısı
tamam = " switchport port-security" 'kontrol edilecek kelime
boş = "YOK" 'interface bulunmazsa yazılacak olan kelime
bulunamadı = "ip_yok" 'ip dökümde bulunmuyorsa yazacak kelime
[B]ipbak2 = "----------------------------------"[/B]
Application.ScreenUpdating = 0
dn = 1
sh2.Range(Cells(2, 2), Cells(son2, fes)).ClearContents

[B]For ip0 = 2 To son2 'sheet2 deki ipler diğer sayfada varmı
    ipk = sh2.Range("A" & ip0)
[COLOR="Red"]    ipka = Replace(ipk, ".", "", 1)[/COLOR]
    Set varmı = sh1.Range("A1:A" & son1).Find(ipk, , xlValues, xlPart)
    If varmı Is Nothing Then
        MsgBox ip0 & ". satırdaki " & ipk & " verisi bulunamadı.", vbInformation, "UYARI" 'bulunamayan ipler için uyarı bu satır silinebilir
        sh2.Range("B" & ip0) = bulunamadı
[COLOR="Red"]        Set varmıa = sh1.Range("A1:A" & son1).Find(ipka, , xlValues, xlPart)
        If Not varmıa Is Nothing Then
            sh2.Range("A" & ip0) = ipka
            MsgBox ip0 & ". satırdaki " & ipk & " verisi " & sh2.Range("A" & ip0) & " olarak bulundu.", vbInformation, "UYARI" 'bulunamayan ipler için uyarı bu satır silinebilir
            sh2.Range("B" & ip0) = ""
        End If[/COLOR]
    End If
Next ip0[/B]

For ip = 2 To son2 'sheet2 deki ipleri sırayla kontrol et
[B]dönip:[/B]
    If sh2.Range("B" & ip) = bulunamadı Then ip = ip + 1: GoTo dönip
    ipbak = sh2.Range("A" & ip)
    ek = 0

dönf:
    For f = dn To son1 'sheet1 deki satırları sırayla kontrol et
        If sh1.Range("A" & f) = "" Then
            dn = f + 1
            GoTo dönf
            End If
        If sh1.Range("A" & f) = ipbak Then
            dn = f + 1
            ek = 0
            GoTo dönf
            End If
[B]        If sh1.Range("A" & f) = ipbak2 Then
            ip = ip + 1
            dn = f + 1
            GoTo dönip
            End If[/B]
        If sh1.Range("A" & f) = sh2.Range("B1").Offset(0, ek) Then
            dn = f + 1
            GoTo dönf
            End If
        If sh1.Range("A" & f) = sh2.Range("B1").Offset(0, ek + 1) Then
            ek = ek + 1
            dn = f + 1
            GoTo dönf
            End If
        If sh1.Range("A" & f) = tamam Then
            Range("B" & ip).Offset(0, ek) = tamam
            dn = f + 1
            GoTo dönf
            End If
    Next f
Next ip

For r = 2 To son2 ' değer bulunamayan hücrelere boş değerini yazar.
dönr:
If sh2.Cells(r, 2) = bulunamadı Then r = r + 1: GoTo dönr
    For c = 2 To 6
        If sh2.Cells(r, c) = "" Then sh2.Cells(r, c) = boş
    Next c
Next r
Application.ScreenUpdating = 1
MsgBox "Bitti.", vbInformation, "Tamamlandı"
End Sub

 

[u.L.a.s]

en son gönderdiğiniz kodu denedim. malesef IP bilgisini bulamıyor.
IP değerihücrede arada nokta varmıl gibi görünmesine rğamen hücre içeriğinde nokta olmadığını alttaki resimden görebilirsiniz

görüntüsü aşağıdaki gibidir.

Eğer ilk kodu yaparsam görüntü aşağıdaki gibi oluyor.

 

[Kardiyak]

Resim görünmüyor. Son mesajı düzelttim. Tekrar kontrol edermisiniz.

Eğer ilk kodda çalışıyorsa muhtemelen find kodu karşılaştırmayı yapamıyordur. İlk koddaki gibi dögü ile tek tek kontrol etmek için aşağıdaki kodu deneyin. Bu hali ile sheet2'deki 10.10.10.10 ile sheet1'deki 10101010 bir biri ile eşleşmemekte ve bulunamamakta ama ilk kodda çalışıyor dediğiniz için ve bu da ilk koddaki yöntem ile arama yaptığı için sizde çalışması gerek. Eğer yine hata veriyorsa hücrelerin formatlarına bakmam için bir örnek dosya göndermeniz gerekiyor.

Sub denemeeksili()
Dim ipk, ipbak, ipbak2, tamam, boş, bulunamadı As String
Dim dn, son1, son2, fes As Integer
Dim sh1, sh2 As Worksheet
Set sh1 = Sheets("Sheet1") 'bakılacak liste sayfasının adı
Set sh2 = Sheets("Sheet2") 'yazılacak sayfanın adı
son1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
son2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
fes = 5 'interface FastEthernet sütun sayısı
tamam = " switchport port-security" 'kontrol edilecek kelime
boş = "YOK" 'interface bulunmazsa yazılacak olan kelime
bulunamadı = "ip_yok" 'ip dökümde bulunmuyorsa yazacak kelime
ipbak2 = "----------------------------------"
Application.ScreenUpdating = 0
dn = 1
sh2.Range(Cells(2, 2), Cells(son2, fes)).ClearContents

[B]For ip0 = 2 To son2 'sheet2 deki ipler diğer sayfada varmı
    ipk = sh2.Range("A" & ip0)
    For f0 = 1 To son1
       If sh1.Range("A" & f0) = ipk Then GoTo çıkip0
    Next f0
    MsgBox ip0 & ". satırdaki " & ipk & " verisi bulunamadı.", vbInformation, "UYARI" 'bulunamayan ipler için uyarı bu satır silinebilir
    sh2.Range("B" & ip0) = bulunamadı
çıkip0:
Next ip0
[/B]
For ip = 2 To son2 'sheet2 deki ipleri sırayla kontrol et
dönip:
    If sh2.Range("B" & ip) = bulunamadı Then ip = ip + 1: GoTo dönip
    ipbak = sh2.Range("A" & ip)
    ek = 0

dönf:
    For f = dn To son1 'sheet1 deki satırları sırayla kontrol et
        If sh1.Range("A" & f) = "" Then
            dn = f + 1
            GoTo dönf
            End If
        If sh1.Range("A" & f) = ipbak Then
            dn = f + 1
            ek = 0
            GoTo dönf
            End If
        If sh1.Range("A" & f) = ipbak2 Then
            ip = ip + 1
            dn = f + 1
            GoTo dönip
            End If
        If sh1.Range("A" & f) = sh2.Range("B1").Offset(0, ek) Then
            dn = f + 1
            GoTo dönf
            End If
        If sh1.Range("A" & f) = sh2.Range("B1").Offset(0, ek + 1) Then
            ek = ek + 1
            dn = f + 1
            GoTo dönf
            End If
        If sh1.Range("A" & f) = tamam Then
            Range("B" & ip).Offset(0, ek) = tamam
            dn = f + 1
            GoTo dönf
            End If
    Next f
Next ip

For r = 2 To son2 ' değer bulunamayan hücrelere boş değerini yazar.
dönr:
If sh2.Cells(r, 2) = bulunamadı Then r = r + 1: GoTo dönr
    For c = 2 To 6
        If sh2.Cells(r, c) = "" Then sh2.Cells(r, c) = boş
    Next c
Next r
Application.ScreenUpdating = 1
MsgBox "Bitti.", vbInformation, "Tamamlandı"
End Sub

 

[u.L.a.s]

Tamam sanırım şu an oluyor.

ufak bir sorun daha var.

Örneğin Sheet2 de "A23" de bir ip Sheet1 de var. IP yi bulup sonuçlarını yazdırıyor.
Altındaki yani A24 teki IP değerinide bulup sonucunuda yazdırıyor..

Ben deneme olsun diye A23 te yazan ip değerini sheet1 de olmayan bir ip değeri yazıyorum. diyelimki 10.20.30.40 var. ama 10.20.85.85 yazıyorum sheet1 de olmayınca ip yok yazıyor.

ama altındaki hücredeki A24 deki ip değerinin karşısında yazan değerler farklılaşıyor bu seferde. ben size çalıştığım örnek dosyayı gönderiyorum. Aşağıdaki linkten indirebilirsiniz.

Sheet2 deki A23 teki IP yi kırmızı renklendirdim. A22 de yazan ip değeri mesela Sheet1 de olmadığı için ip yok demiş. ve A23 teki ip karşılığındaki nterface Fastethernet 0/1 değeri altına Yok yazıyor. halbuki var aslında port security değeri ama bir üst satırda ip yok bilgisi yazdığı için bir alt satırdaki ip de değerler düzgün yansımıyor.

http://s4.dosya.tc/server3/rhq01n/Soru.rar.html

 

[Kardiyak]

Dosyayı kontrol ettim.
Kırmızı ile işaretlediğiniz ip 42.37.179.253, sheet1 de 2, sheet2 de 3 defa tekrar ediyor.
Bu tekrar eden veriler hataya sebep olur.
Çünkü sheet2 deki 42.37.179.253 ipsi, sheet1 deki 1340 mı yoksa 1741.satırdaki 42.37.179.253 ip si ile karşılaştırılacak bunu excel çözemez.
Döngü artan sıra ile gittiği için
sheet2 23. satırdaki 42.37.179.253 ipsi sheet1 de 1340. satırda bulunduktan sonra,
sheet2 25. satırdaki aynı ip sheet1 de 1416. satırdan sonra aranmaya devam edecek ve sheet1 de 1741.satırda bulunacaktır.
sheet2 32.satırdaki aynı ip sheet1 de 1817.satırdan sonra aranacak ve bulunamayacaktır.


Bu ip tekrarları normal mi?

 

[u.L.a.s]

evet aslında olmaması gerekiyor. çok haklısınız.
O halde ip tekrarları olmayacak şekilde ben veri çekmem gerekiyor. ben o kısmı ayalarım
şimdi 1741 satırındaki ip ve alt bilgilerini listeden çıkarttım. ve tekrar makro kodunu çalıştırdım.

bir üst satırdaki 10.37.143.252 nolu ip yi bulamayıp ip yok yazıyor ya. 42.37.179.253 ip bilgisi altında aşağıdaki bilgiler Sheet1 de var. fakat Sheet2 de her nasıl oluyorsa fastethernet1 ve fastethernet4 te yok bilgisi geliyor. kırmızı renkle işaretledim

42.37.179.253	[B][COLOR="Red"]YOK[/COLOR][/B]	 switchport port-security	 switchport port-security	[COLOR="Red"][B]YOK[/B][/COLOR]	 switchport port-security

42.37.179.253
Building configuration...

Current configuration : 383 bytes
!
[B][COLOR="Red"]interface FastEthernet0/1[/COLOR][/B]
 switchport access vlan 2
 switchport mode access
 switchport voice vlan 11
 switchport port-security maximum 2
[B][COLOR="Red"] switchport port-security[/COLOR][/B]
 switchport port-security mac-address sticky
 switchport port-security mac-address sticky 0021.5a65.3308 vlan access
 switchport port-security mac-address sticky 20bb.c020.4340 vlan voice
 spanning-tree portfast
end

Building configuration...

Current configuration : 383 bytes
!
interface FastEthernet0/2
 switchport access vlan 2
 switchport mode access
 switchport voice vlan 11
 switchport port-security maximum 2
 switchport port-security
 switchport port-security mac-address sticky
 switchport port-security mac-address sticky 3cd9.2b60.4c32 vlan access
 switchport port-security mac-address sticky 20bb.c020.4b4b vlan voice
 spanning-tree portfast
end

Building configuration...

Current configuration : 224 bytes
!
interface FastEthernet0/3
 switchport access vlan 4
 switchport mode access
 switchport voice vlan 11
 switchport port-security
 switchport port-security mac-address aaaa.bbbb.7003 vlan access
 spanning-tree portfast
end

Building configuration...

Current configuration : 383 bytes
!
[B][COLOR="Red"]interface FastEthernet0/4[/COLOR][/B]
 switchport access vlan 2
 switchport mode access
 switchport voice vlan 11
 switchport port-security maximum 2
[B][COLOR="Red"] switchport port-security[/COLOR][/B]
 switchport port-security mac-address sticky
 switchport port-security mac-address sticky 7446.a09c.4dbf vlan access
 switchport port-security mac-address sticky 20bb.c021.ece6 vlan voice
 spanning-tree portfast
end

Building configuration...

Current configuration : 224 bytes
!
interface FastEthernet0/5
 switchport access vlan 4
 switchport mode access
 switchport voice vlan 11
 switchport port-security
 switchport port-security mac-address aaaa.bbbb.7005 vlan access
 spanning-tree portfast
end

 

[Kardiyak]

Diğer koddaki hatayı çözemedim. Mecburen iç içe for next yaptım yine.
bu sefer sheet2 deki her ip için sheet1 den ilk satırdan itibaren yeniden aram yapıyor.
yani sheet1 de bir ip için birden çok veri varsa sadece ilk olanları bulup karşılaştıracak.

Sub denemeeksili()
Dim ipk, ipbak, ipbak2, tamam, boş, bulunamadı As String
Dim dn, son1, son2, fes As Integer
Dim sh1, sh2 As Worksheet
Set sh1 = Sheets("Sheet1") 'bakılacak liste sayfasının adı
Set sh2 = Sheets("Sheet2") 'yazılacak sayfanın adı
son1 = sh1.Range("A" & Rows.Count).End(xlUp).Row 'sheet1 son dolu satır
son2 = sh2.Range("A" & Rows.Count).End(xlUp).Row 'sheet2 son dolu satır
fes = 5 'interface FastEthernet sütun sayısı
tamam = " switchport port-security" 'kontrol edilecek kelime
boş = "YOK" 'interface bulunmazsa yazılacak olan kelime
bulunamadı = "ip_yok" 'ip dökümde bulunmuyorsa yazacak kelime
ip2bak = "----------------------------------" 'ip satırları bitişi için bakılacak değer
feson = "end" ' interface FastEthernet satırları bitişi için bakılacak değer
dn = 1 'sheet1 deki verinin başlangıç satırı
Application.ScreenUpdating = 0
sh2.Range(Cells(2, 2), Cells(son2 + 1, fes + 1)).ClearContents

'// Sheet2 deki ipler sheet1 de var mı?
For ip0 = 2 To son2
    ipk = sh2.Range("A" & ip0)
    For f0 = 1 To son1
       If sh1.Range("A" & f0) = ipk Then GoTo çıkip0
    Next f0
    'MsgBox ip0 & ". satırdaki " & ipk & " verisi bulunamadı.", vbInformation, "UYARI"
    sh2.Range("B" & ip0) = bulunamadı
çıkip0:
Next ip0

'// Sheet2 deki ipleri sırayla kontrol et
For ip = 2 To son2
If sh2.Range("B" & ip) = bulunamadı Then GoTo atlaip
ipbak = sh2.Range("A" & ip)
ek = 0

If ipbak = "" Then GoTo atlaip
    For f = 1 To son1
    'ip satırları başlangıcı
    If sh1.Range("A" & f) = ipbak Then
döns:
        For i = f + 1 To son1
        'interface FastEthernet x başlangıcı
        If sh1.Range("A" & i) = sh2.Range("B1").Offset(0, ek) Then
        If ek > fes - 1 Then GoTo atlaip
            For s = i To son1
            'switchport port-security varmı
            If sh1.Range("A" & s) = tamam Then Range("B" & ip).Offset(0, ek) = tamam: _
                i = s + 1: _
                ek = ek + 1: _
                GoTo döns
            'interface FastEthernet satırları için için son
            If sh1.Range("A" & s) = "end" Then ek = ek + 1: _
                i = s + 1: _
                GoTo döns
            'ip satırları için son
            If sh1.Range("A" & s) = ip2bak Then GoTo atlaip
            Next s
        End If
        Next i
    End If
    Next f
atlaip:
Next ip

'// Değer bulunamayan hücrelere boş değerini yazma
For r = 2 To son2
dönr:
If sh2.Cells(r, 2) = bulunamadı Then r = r + 1: GoTo dönr
    For c = 2 To 6
        If sh2.Cells(r, c) = "" Then sh2.Cells(r, c) = boş
    Next c
Next r

Application.ScreenUpdating = 1
MsgBox "Bitti.", vbInformation, "Tamamlandı"
End Sub

 

[u.L.a.s]

Üstadım emeğine bilgine sağlık. çok uğraştırdım seni. çok çok teşekkür ediyorum.

Ben şimdi temiz bir listeyle son kodu deneyeceğim