[ÇÖZÜLDÜ] Tüm sayfaları seçmek.. ?

[macay]

Sayın Üstadlar...

Sayın Levent Menteşoğlunun yardımıyla aşağıdaki kodu kullanıyorum.. fakat bu kod sadece tek sayfa seçiyor bütün sayfaları seçtirmem için nasıl bir kod yazmam gerekir

Sub verilerigetir()
Set s1 = Sheets("144-2").... (Bu kısımda bütün sayfaları seçtirip s1 atamak mümkünmü)
Set s2 = Workbooks("Flyt.xls").Sheets("234933SarfTbloMktr")
Set s3 = Workbooks("Flyt.xls").Sheets("234933SarfTbloTutr")
For a = 13 To s1.[d538].End(3).Row
If s1.Cells(a, "d") = "" Then GoTo 10
If WorksheetFunction.CountIf(s2.[a:a], s1.Cells(a, "d")) > 0 Then
sat1 = WorksheetFunction.Match(s1.Cells(a, "d"), s2.[a:a], 0)
sat2 = WorksheetFunction.Match(s1.Cells(a, "d"), s3.[a:a], 0)
sut = WorksheetFunction.Match(s1.[y1], s2.[2:2], 0)
s1.Cells(a, "y") = s2.Cells(sat1, sut)
s1.Cells(a, "z") = s3.Cells(sat2, sut)
Else
s1.Cells(a, "y") = 0
s1.Cells(a, "z") = 0
End If
10 Next
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi bir döngü kullanabilirsiniz. 2.sayfadan itibaren taradığı kabul edilmiştir.

Sub verilerigetir()
for a=2 to sheets.count
Set s1 = Sheets(a).... [COLOR=red][B](Bu kısımda bütün sayfaları seçtirip s1 atamak mümkünmü)[/B][/COLOR]
Set s2 = Workbooks("Flyt.xls").Sheets("234933SarfTbloMktr")
Set s3 = Workbooks("Flyt.xls").Sheets("234933SarfTbloTutr")
For a = 13 To s1.[d538].End(3).Row
If s1.Cells(a, "d") = "" Then GoTo 10
If WorksheetFunction.CountIf(s2.[a:a], s1.Cells(a, "d")) > 0 Then
sat1 = WorksheetFunction.Match(s1.Cells(a, "d"), s2.[a:a], 0)
sat2 = WorksheetFunction.Match(s1.Cells(a, "d"), s3.[a:a], 0)
sut = WorksheetFunction.Match(s1.[y1], s2.[2:2], 0)
s1.Cells(a, "y") = s2.Cells(sat1, sut)
s1.Cells(a, "z") = s3.Cells(sat2, sut)
Else
s1.Cells(a, "y") = 0
s1.Cells(a, "z") = 0
End If
10 Next
next
End Sub

 

[macay]

Sayın Levent Bey,

sut = WorksheetFunction.Match(s1.[y1], s2.[2:2], 0) satırında "y1" değerinin boş veya 0 olması durumunda kod çalışmayı bırakıyor ve workshetts fonk özelliğinin macth özelliği alınamıyor mesajı veriyor... bunu nasıl atlatabiliriz üstad... ?

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

[LEFT]Sub verilerigetir()
for a=2 to sheets.count
Set s1 = Sheets(a).... [COLOR=red][B](Bu kısımda bütün sayfaları seçtirip s1 atamak mümkünmü)[/B][/COLOR]
Set s2 = Workbooks("Flyt.xls").Sheets("234933SarfTbloMktr")
Set s3 = Workbooks("Flyt.xls").Sheets("234933SarfTbloTutr")
For a = 13 To s1.[d538].End(3).Row
If s1.Cells(a, "d") = "" Then GoTo 10
say1=WorksheetFunction.CountIf(s2.[a:a], s1.Cells(a, "d"))
say2=WorksheetFunction.CountIf(s2.[2:2], s1.[y1])
If say1> 0 and say2>0 Then
sat1 = WorksheetFunction.Match(s1.Cells(a, "d"), s2.[a:a], 0)
sat2 = WorksheetFunction.Match(s1.Cells(a, "d"), s3.[a:a], 0)
sut = WorksheetFunction.Match(s1.[y1], s2.[2:2], 0)
s1.Cells(a, "y") = s2.Cells(sat1, sut)
s1.Cells(a, "z") = s3.Cells(sat2, sut)
Else
s1.Cells(a, "y") = 0
s1.Cells(a, "z") = 0
End If
10 Next
next
End Sub

[/LEFT]

 

[macay]

Sayın Levent Bey,

yardımlarınız için teşekkür ederim.. Kod çalışıyor ama bir problem var... ekte gönderdiğim iki adet dosya var Bskl dosyasının 230-1 sayfasındaki Z39 hücresine gelen değerin oraya gelmemesi gerekiyor... çünkü Y1 hücresinde okuduğu 000972 değerini FlytHzrlk dosyasında hem 234933sarftblomktr hemde 234933 sarftblotutr [2:2] satırında arayarak ilgili satıra oradaki değerin gelmesi lazım...yani miktar sayfasından AZ46 hücresinin değeri Tutar sayfasından ise V37 Hücresinin değerinin 230-1 sayfasındaki Y141 hücresine gelmesi lazım... ilginç olan ilk sayfa olan 222-1 sayfasına değerler doğru geliyor çok kafa patlattım sizi rahatsız etmeyeyim diye ama bulamadım...

 

[Levent Menteşoğlu]

Aşağıdaki kodu denermisiniz.

Sub verilerigetir()
Set s2 = Workbooks("FlytHzrlk.xls").Sheets("234933SarfTbloMktr")
Set s3 = Workbooks("FlytHzrlk.xls").Sheets("234933SarfTbloTutr")
For a = 1 To Sheets.Count
Set s1 = Sheets(a)
For b = 13 To s1.[d538].End(3).Row
If s1.Cells(b, "d") = "" Then GoTo 10
say1 = WorksheetFunction.CountIf(s2.[a:a], s1.Cells(b, "d"))
say2 = WorksheetFunction.CountIf(s2.[2:2], s1.[y1])
If say1 > 0 And say2 > 0 Then
sat1 = WorksheetFunction.Match(s1.Cells(b, "d"), s2.[a:a], 0)
sat2 = WorksheetFunction.Match(s1.Cells(b, "d"), s3.[a:a], 0)
sut1 = WorksheetFunction.Match(s1.[y1], s2.[2:2], 0)
sut2 = WorksheetFunction.Match(s1.[y1], s3.[2:2], 0)
s1.Cells(b, "y") = s2.Cells(sat1, sut1)
s1.Cells(b, "z") = s3.Cells(sat2, sut2)
Else
s1.Cells(b, "y") = 0
s1.Cells(b, "z") = 0
End If
10 Next
Next
End Sub

 

[macay]

Sayın Levent Bey,

Çözümünüz için çok teşekkür ederim...Bilginize sağlık... Allah sizden razı olsun

Saygılarımla,