Kısa kod ile veri çekmek

3641 · 16 Nisan 2012

thisworkbook bölümüne yazılacak kod ile aşağıdaki örnek çalışmayı yapmak mümkünmü acaba.
Neden thisworkbook bölümüne derseniz bilgileri çekeceğim sayfaya kod yazdığımda çalışma sayfası ağırlaşıyor oysa thisworkbook bölümüne yazıp her sayfa kısa kod ile "liste" sayfasından verileri çekecek dersem çalışma kitabım hızlanır gibi geliyor ama beceremiyorum yardım lütfen.

3641 · 16 Nisan 2012

Yapılabilir mi acaba?

numan şamil · 16 Nisan 2012

3641' Alıntı:
Yapılabilir mi acaba?

Merhaba
Sizin dediğiniz şekilde değilde başka bir yöntem
Ekli dosyayı incelermisiniz
1) ilksayfa ve son sayfa arasında eklenen bütün sayfalarda işlem görür
2) Eklenecek sayfaların kod sayfasına Sayfa1 in kod sayfasında bulunan kodları kopyalamanız gerekiyor veya sayfa1 kopyalayarak ekleyebilirsiniz
Umarım istediğiniz hızda çalışır sanırım.

3641 · 16 Nisan 2012

Üye arkadaşlardan birinin yazdığı aşağıdaki kodu kendime göre düzeltmeye çalıştım,
thisworkbook bölümüne aşağıdaki kodu yazdığımda işimi çözüyor, Firmalar isimli sayfadan Çitf tıkla Firma iletişim bilgilerini gönderdiğimde "If Intersect(Target, Range("A11:A3000")) Is Nothing Then Exit Sub" kodu hata veriyor, nedenini Diğer kodda bulunan "If Intersect" kısmından kaynaklı hata alıyorum diye düşündüm ama çözemedim, aşağıdaki kodu daha hızlı çalışacak şekilde düzenleyebilirmiyiz acaba,

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name <> "liste" Then
If Intersect(Target, Range("A11:A3000")) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Sheets("liste").Range("A2:A3000"), _
Target.Value) > 0 Then
Cells(Target.Row, "B") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:E3000"), 2, 0)
Cells(Target.Row, "C") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:E3000"), 3, 0)
Cells(Target.Row, "D") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:E3000"), 4, 0)
Cells(Target.Row, "E") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:E3000"), 5, 0)
Cells(Target.Row, "G") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:G3000"), 7, 0)
Cells(Target.Row, "H") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:H3000"), 8, 0)
Cells(Target.Row, "I") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:I3000"), 9, 0)
Cells(Target.Row, "J") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:J3000"), 10, 0)
Cells(Target.Row, "K") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:K3000"), 11, 0)
Cells(Target.Row, "P") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2

3000"), 16, 0)
Cells(Target.Row, "Q") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:Q3000"), 17, 0)
Cells(Target.Row, "R") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:R3000"), 18, 0)
Cells(Target.Row, "S") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:S3000"), 19, 0)
Cells(Target.Row, "T") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:T3000"), 20, 0)
Cells(Target.Row, "U") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:U3000"), 21, 0)
Cells(Target.Row, "V") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:V3000"), 22, 0)
Cells(Target.Row, "W") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:W3000"), 23, 0)
Cells(Target.Row, "X") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:X3000"), 24, 0)
Cells(Target.Row, "Y") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:Y3000"), 25, 0)
End If
End If
End Sub

numan şamil · 17 Nisan 2012

3641' Alıntı:
Üye arkadaşlardan birinin yazdığı aşağıdaki kodu kendime göre düzeltmeye çalıştım,
thisworkbook bölümüne aşağıdaki kodu yazdığımda işimi çözüyor, Firmalar isimli sayfadan Çitf tıkla Firma iletişim bilgilerini gönderdiğimde "If Intersect(Target, Range("A11:A3000")) Is Nothing Then Exit Sub" kodu hata veriyor, nedenini Diğer kodda bulunan "If Intersect" kısmından kaynaklı hata alıyorum diye düşündüm ama çözemedim, aşağıdaki kodu daha hızlı çalışacak şekilde düzenleyebilirmiyiz acaba,

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name <> "liste" Then
If Intersect(Target, Range("A11:A3000")) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Sheets("liste").Range("A2:A3000"), _
Target.Value) > 0 Then
Cells(Target.Row, "B") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:E3000"), 2, 0)
Cells(Target.Row, "C") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:E3000"), 3, 0)
Cells(Target.Row, "D") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:E3000"), 4, 0)
Cells(Target.Row, "E") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:E3000"), 5, 0)
Cells(Target.Row, "G") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:G3000"), 7, 0)
Cells(Target.Row, "H") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:H3000"), 8, 0)
Cells(Target.Row, "I") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:I3000"), 9, 0)
Cells(Target.Row, "J") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:J3000"), 10, 0)
Cells(Target.Row, "K") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:K3000"), 11, 0)
Cells(Target.Row, "P") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A23000"), 16, 0)
Cells(Target.Row, "Q") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:Q3000"), 17, 0)
Cells(Target.Row, "R") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:R3000"), 18, 0)
Cells(Target.Row, "S") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:S3000"), 19, 0)
Cells(Target.Row, "T") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:T3000"), 20, 0)
Cells(Target.Row, "U") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:U3000"), 21, 0)
Cells(Target.Row, "V") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:V3000"), 22, 0)
Cells(Target.Row, "W") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:W3000"), 23, 0)
Cells(Target.Row, "X") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:X3000"), 24, 0)
Cells(Target.Row, "Y") = WorksheetFunction.VLookup(Target, Sheets("liste"). _
Range("A2:Y3000"), 25, 0)
End If
End If
End Sub

Merhaba
Hata almanızın muhtemelen nedeni kırmızı olan yerde boşluk bırakılmış
If WorksheetFunction.CountIf(Sheets("liste").Range(" A 2:A3000"), _
Target.Value) > 0 Then
Ayrıca
If Intersect(Target, Range("A11:A3000")) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Sheets("liste").Range("A2:A3000"), _
Target.Value) > 0 Then
Örnek dosyana göre,
If Intersect(Target, Range("A10:A3000")) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Sheets("liste").Range("A2:A3000"), _
Target.Value) > 0 Then
olmalıdır.
NOT: A stunu dahil bütün satırdaki verileri seçip silme yaparsanız kod hata verir.
Ekli dosya çalışır vaziyette
İncelermisiniz

3641 · 17 Nisan 2012

Sayın Numan ŞAMİL,
İlginiz ve yardımınız için teşekkür ederim.

assenucler · 17 Nisan 2012

Sayın Numan Şamil;

Üstadım benim için de yararlı bir örnek oldu. Teşekkürler.

numan şamil · 18 Nisan 2012

3641' Alıntı:
Sayın Numan ŞAMİL,
İlginiz ve yardımınız için teşekkür ederim.

Rica ederim
Kolay gelsin

numan şamil · 18 Nisan 2012

assenucler' Alıntı:
Sayın Numan Şamil;

Üstadım benim için de yararlı bir örnek oldu. Teşekkürler.

Merhaba
Ben sadece Sn:3641' İn kodlarındaki çok ufak yazım hatasını düzelttim
Kolay gelsin

Kısa kod ile veri çekmek

3641

Ekli dosyalar

3641

numan şamil

Destek Ekibi

Ekli dosyalar

3641

numan şamil

Destek Ekibi

Ekli dosyalar

3641

assenucler

numan şamil

Destek Ekibi

numan şamil

Destek Ekibi