Sayfadan veri getirmek

[soykan]

Merhabalar,

Dosyamda birden çok sayfa var. İlk sayfamda diğer sayfalarda olduğunu düşündüğüm bir kodu yazdığımda ona ait bilgileri getirsin istiyorum. Eğer yazdığım kod ile diğer sayfada olan kod birbiri ile aynı ise sorun yok. Ancak aynı satırda bu kod ve virgül ile ayrılmış yan yana kod varsa bunu bulamıyor. Kodları aşağıda yazdım nasıl yapabilirim?

Yazdığım kod : 81803866
Sayfalardan birinde şu şekilde bulunuyor : 81803866, 960E6102B,734460M91, 734460Z91, 81512, 81874, 82113, 82136
Bu kod ortada ya da sonda olabilir.

Sub kodgetir()

Dim i As Integer
Dim a As Integer
Dim c As Integer
For i = 2 To Sheets.Count

For a = 1 To Sheets(i).[a50000].End(3).Row

c = Sayfa1.[a50000].End(3).Row + 1

If Sheets(i).Cells(a, “d”) = Sayfa1.Range(“n1″) Or Sayfa1.Range(“n1″) = Sheets(i).Cells(a, “d”) & “*” Then

Sayfa1.Cells(c, 1) = Sheets(i).Cells(a, “e”)

End If

Next a
Next i

End Sub

 

[Korhan Ayhan]

Merhaba,

Kodunuzun içindeki aşağıdaki satırı bir sonraki ile değiştirip deneyiniz.

Eski kod;

If Sheets(i).Cells(a, “d”) = Sayfa1.Range(“n1″) Or Sayfa1.Range(“n1″) = Sheets(i).Cells(a, “d”) & “*” Then

Yeni kod;

If Sheets(i).Cells(a, “d”) Like "*" & Sayfa1.Range(“n1″) & "*" Then

Ayrıca eğer sayfalarıdaki veri sayınız çoksa döngü yavaş çalışacaktır. Bunun yerine daha hızlı çalışan FIND-BUL komutu ile hazırlanacak kodları kullanabilirsiniz.

Mesela aşağıdaki kod daha hızlı sonuç verecektir.

Sub SAYFALARDA_ARA()
    Dim Sayfa As Worksheet, Aranan As Variant, Bul As Range
    
    Aranan = Sheets("Sayfa1").Range("N1")
    
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> "Sayfa1" Then
            Set Bul = Sayfa.Range("A:A").Find(Aranan, , , xlPart)
            If Not Bul Is Nothing Then
                Sheets("Sayfa1").Cells(Rows.Count, 1).End(3)(2) = Bul.Offset(0, 4)
            End If
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[soykan]

Teşekkürler Find Bul komutu harika ancak ben bulduğunu Sayfa 1 e yazmasını istiyorum