Başka excel dosyasından veri almak

[cem1473]

Arkadaşlar,
Bir türlü yapamadım, Lütfen bir el atabilir misiniz?
Ekteki zip dosyanın içinde 3 adet dosya var. iki tanesi data dosyası (1.csv ve 2.csv) diğer dosyada bu dosyalardan bilgi çekeceğim dosya. (ist.xlsx)
Şimdi bu dosyanın üst kısmındaki IP adresler data dosyalarında varsa olan IP adres satırlarını ist.xlsx e getirmek. Her makro çalıştırdığımda ist.xlsx içindeki datayı silebilir dorun yok. Bir el atında yapalım şunu

 

[security]

Dosyanızı 2003 formatında ekleyiniz herkeste 2007 yok malesef...
sonra bakalım ...

 

[cem1473]

2003 halini ekliyorum

 

[Orion1]

Dosyanız ektedir.

Sub csv_veri_al()
Dim sat As Long, fso As Object, fs As Object, deg, a As String, k As Integer
Dim j As Byte
Sheets("Sheet1").Select
Application.ScreenUpdating = False
Range("A6:IV65536").ClearContents
sat = 6
Set fso = CreateObject("Scripting.FileSystemObject")
For Each fs In fso.getfolder(ThisWorkbook.Path).Files
    If Right(fs.Name, 4) = ".csv" Then
        Open (fs) For Input As #1
        Do While Not EOF(1)
            Line Input #1, a
            deg = Split(a, ",")
            If UBound(deg) >= 11 Then
                For j = 1 To 3
                    If deg(11) Like Cells(j, "B").Value & "*" Then
                        If deg(11) <> "" Then
                            For k = LBound(deg) To UBound(deg)
                                Cells(sat, k + 1).Value = deg(k)
                            Next
                            sat = sat + 1
                            Exit For
                        End If
                    End If
                Next j
            End If
        Loop
        Close #1
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[cem1473]

Buyüksün Evren Hoca. üç küçük şey var

1- En büyük problem Makroyu çalıştırdığımda IP adreste hiç bir şey yazmayanlarda geliyor. Mümkünse gelmesinler.

2- Birde ben filtre yapacağım IP adresin başlarını yazsam sonu ne olursa olsun gelebilir mi? bu uğraştıracaksa hiç uğraşma başka şekilde çözerim.

3-Birde raporlarken 6. satırdan başlıyor raporlamaya ve ikinci kez makroyu çalıştırdığımda 6. satırdan sonrasını silse nasıl olur. Bu da çok mühim değil. Ben ellede halledebilirim.

Ellerine sağlık

 

[Orion1]

Buyüksün Evren Hoca. üç küçük şey var

1- En büyük problem Makroyu çalıştırdığımda IP adreste hiç bir şey yazmayanlarda geliyor. Mümkünse gelmesinler.

2- Birde ben filtre yapacağım IP adresin başlarını yazsam sonu ne olursa olsun gelebilir mi? bu uğraştıracaksa hiç uğraşma başka şekilde çözerim.

3-Birde raporlarken 6. satırdan başlıyor raporlamaya ve ikinci kez makroyu çalıştırdığımda 6. satırdan sonrasını silse nasıl olur. Bu da çok mühim değil. Ben ellede halledebilirim.

Ellerine sağlık

ilk 2 isteğinizi yaptım.
3ncü isteğinizi zaten yapıyordu.
6ncı satırı ve sonrasını önce siliyor sonra listeliyor.
Dosyayı 4ncü mesajdan indirebilirsiniz.

 

[cem1473]

Hocam,
Ben makroyu çalıştırınca runtime error 9 veriyor, bir şeyi yanlış mı yaptım acaba. Bende yeni makrodan If deg(k) <> "" Then satırını silince hata gitti fakat bu seferde ilk isteğim olan Ip adresi eksik yazarsam onları getirmiyor. Ancak birebir aynı olması gerekiyor

ilk 2 isteğinizi yaptım.
3ncü isteğinizi zaten yapıyordu.
6ncı satırı ve sonrasını önce siliyor sonra listeliyor.
Dosyayı 4ncü mesajdan indirebilirsiniz.

 

[Orion1]

Hocam,
Ben makroyu çalıştırınca runtime error 9 veriyor, bir şeyi yanlış mı yaptım acaba. Bende yeni makrodan If deg(k) <> "" Then satırını silince hata gitti fakat bu seferde ilk isteğim olan Ip adresi eksik yazarsam onları getirmiyor. Ancak birebir aynı olması gerekiyor

benim yolladığım dosyada hata yoktu çalışıyordu.
Siz hatalı dosyayı ve cvs dosyalarını yollarmısınız?

 

[Orion1]

Hocam,
Ben makroyu çalıştırınca runtime error 9 veriyor, bir şeyi yanlış mı yaptım acaba. Bende yeni makrodan If deg(k) <> "" Then satırını silince hata gitti fakat bu seferde ilk isteğim olan Ip adresi eksik yazarsam onları getirmiyor. Ancak birebir aynı olması gerekiyor

Evet teknik bir hata olmuş
O kodu aşağıdaki ile değiştiriniz.

If deg(11) <> "" Then

 

[cem1473]

Evet hocam çalıştı çok saol. Son olorak çalışmayan bir şey var. Ben B1 e 172.26.9. yazıyorum ve başı 172.26.9. ile başlayanları getirmiyor. 172.26.9.46
yazarsam getiriyor fakat sonu çok değişken olduğu için çok zorluyor. Varmıdır bir çözüm. Sabrın sınırlarını zorluyorum

Evet teknik bir hata olmuş
O kodu aşağıdaki ile değiştiriniz.

If deg(11) <> "" Then

 

[Orion1]

Evet hocam çalıştı çok saol. Son olorak çalışmayan bir şey var. Ben B1 e 172.26.9. yazıyorum ve başı 172.26.9. ile başlayanları getirmiyor. 172.26.9.46
yazarsam getiriyor fakat sonu çok değişken olduğu için çok zorluyor. Varmıdır bir çözüm. Sabrın sınırlarını zorluyorum

Dosyayı güncelledim.
4 numaralı mesajdan dosyayı indirebilirsiniz.

 

[cem1473]

Evren Hocam,
Akşam akşam seni yorduk. Allah Razı olsun. Allah ne muradın varsa versin

Çok çok saol

 

[Orion1]

Evren Hocam,
Akşam akşam seni yorduk. Allah Razı olsun. Allah ne muradın varsa versin

Çok çok saol

Rica ederim.
İyi çalışmalar.