For Each Veri 2 Farklı Sayfada Arama

T

__TR__

Katılım
29 Kasım 2008
Mesajlar
70
Excel Vers. ve Dili
Microsoft 2010
Konu başlığını olabildiğince konu ile alakalı yazmaya çalıştım umarım doğru olmuştur. Günlerdir çözemediğim bir makro konusunda yardım gerekli. aşağıdaki makro ile şarta bağlı olarak bir kaç sayfadan veri çekiyorum. Düzenleyemediğim kısım for eac veri in kısmı;

Kod: 
Private Sub CommandButton1_Click()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, S4 As Worksheet
Dim Veri As Range, Satır As Long
Dim i As Integer, s As Worksheet, son As Long
Dim txt As Control

    Set S1 = Sheets("Sayfa2")
    Set S2 = Sheets("Tabela")
    Set S3 = Sheets("Ambar")
    Set S4 = Sheets("Menü")
   son = S2.Range("a65536").End(3).Row
    Application.ScreenUpdating = False
    If TextBox29.Value = "" Then
MsgBox " Lütfen tüm alanları doldurunuz!", vbCritical, "UYARI!"
Exit Sub
End If
  S2.Range("A17:L59").Value = Empty
            For Each Veri In S1.Range("F3:F" & S1.Range("F65536").End(3).Row)
        If Veri.Value = CDate(TextBox29.Text) Then
        If S1.Cells(Veri.Row, "E") <> "" Then
            Satır = Satır + 1
                S2.Cells(16 + Satır, "A") = S1.Cells(Veri.Row, "B")
                S2.Cells(16 + Satır, "J") = S1.Cells(Veri.Row, "E")
                S2.Cells(16 + Satır, "K") = S1.Cells(Veri.Row, "C")
                S2.Cells(16 + Satır, "L") = S3.Cells(Veri.Row, "D")
                'S2.Cells(5 + Satır, "J") = S4.Cells(Veri.Row, "B")
           End If
        End If

    Next
For Each Veri in S1.Range("F3:F" & S1.Range("F65536").End(3).Row) olan bölümle aranan veriyi S4.Range("A2:A" & S4.Range("A65536").End(3).Row) S4'te de aramak istiyorum. S2'nin J sütununa gelecek olan veri S4'ün B sütununda, textbox ile aranan tarihe ait veriler bir formda toplanıyor, yardımcı olursanız sevinirim.

Not: Kullandığım internetin bir çok siteye erişimi kısıtlı olduğu için örnek bir dosya ekleyemedim.
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,067
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Birinci for each/next döngüsünden sonra ikinci bir for each/next döngüsü yapmayı denediniz mi?
 
T

__TR__

Katılım
29 Kasım 2008
Mesajlar
70
Excel Vers. ve Dili
Microsoft 2010
For each veri1 in s4.Range(A2:A" & S4.Range("A65536").End(3).Row)
S2.Cells(5 + Satır, "J") = S4.Cells(Veri1.Row, "B")

şeklinde denedim ancak olmadı, olmayan kısmı şöyle istenileni yaptı ama diğer formüller işlevini yitirdi.

Kod: 
Private Sub CommandButton1_Click()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, S4 As Worksheet
Dim Veri As Range, Satır As Long
Dim i As Integer, s As Worksheet, son As Long
Dim txt As Control

    Set S1 = Sheets("Sayfa2")
    Set S2 = Sheets("Tabela")
    Set S3 = Sheets("Ambar")
    Set S4 = Sheets("Menü")
   son = S2.Range("a65536").End(3).Row
    Application.ScreenUpdating = False
    If TextBox29.Value = "" Then
MsgBox " Lütfen tüm alanları doldurunuz!", vbCritical, "UYARI!"
Exit Sub
End If
  S2.Range("A17:L59").Value = Empty
            For Each Veri In S1.Range("F3:F" & S1.Range("F65536").End(3).Row)
            'For Each Veri1 In S4.Range("A2:A" & S4.Range("A65536").End(3).Row)
               
        If Veri.Value = CDate(TextBox29.Text) Then
        If S1.Cells(Veri.Row, "E") <> "" Then
            Satır = Satır + 1
       
                S2.Cells(16 + Satır, "A") = S1.Cells(Veri.Row, "B")
                S2.Cells(16 + Satır, "J") = S1.Cells(Veri.Row, "E")
                S2.Cells(16 + Satır, "K") = S1.Cells(Veri.Row, "C")
                S2.Cells(16 + Satır, "L") = S3.Cells(Veri.Row, "D")
                'S2.Cells(5 + Satır, "J") = S4.Cells(Veri1.Row, "B")
                'S2.Cells(5 + Satır, "M") = S4.Cells(Veri1.Row, "C")
                'S2.Cells(5 + Satır, "P") = S4.Cells(Veri1.Row, "D")
                'S2.Cells(5 + Satır, "S") = S4.Cells(Veri1.Row, "E")
               
           End If
           End If
     
Next

    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Application.ScreenUpdating = True

Sheets("Tabela").[C6] = TextBox1.Text
Sheets("Tabela").[C7] = TextBox2.Text
Sheets("Tabela").[C8] = TextBox3.Text
Sheets("Tabela").[C9] = TextBox4.Text
Sheets("Tabela").[C10] = TextBox5.Text
Sheets("Tabela").[C11] = TextBox6.Text
Sheets("Tabela").[C12] = TextBox7.Text
Sheets("Tabela").[D6] = TextBox8.Text
Sheets("Tabela").[D7] = TextBox9.Value
Sheets("Tabela").[D8] = TextBox10.Value
Sheets("Tabela").[D9] = TextBox11.Value
Sheets("Tabela").[D10] = TextBox12.Value
Sheets("Tabela").[D11] = TextBox13.Value
Sheets("Tabela").[D12] = TextBox14.Value
Sheets("Tabela").[E6] = TextBox15.Text
Sheets("Tabela").[E7] = TextBox16.Value
Sheets("Tabela").[E8] = TextBox17.Value
Sheets("Tabela").[E9] = TextBox18.Value
Sheets("Tabela").[E10] = TextBox19.Value
Sheets("Tabela").[E11] = TextBox20.Value
Sheets("Tabela").[E12] = TextBox21.Value
Sheets("Tabela").[F6] = TextBox22.Text
Sheets("Tabela").[F7] = TextBox23.Value
Sheets("Tabela").[F8] = TextBox24.Value
Sheets("Tabela").[F9] = TextBox25.Value
Sheets("Tabela").[F10] = TextBox26.Value
Sheets("Tabela").[F11] = TextBox27.Value
Sheets("Tabela").[F12] = TextBox28.Value

Sheets("Tabela").[A2] = TextBox29.Value & " TARİHLİ GÜNLÜK YEMEK TABELASI"
Sheets("Tabela").[A62] = "     Bu tabela " & TextBox29.Value & " tarihinde, yukarıdaki kişi mevcuduna ve yemek listesine göre hesaplanarak yapılmıştır."
Sheets("Tabela").[W4] = TextBox29.Value
For Each txt In Me.Controls
    If TypeName(txt) = "TextBox" Then txt.Value = ""
Next
MsgBox "Tabela hazırlandı. Çıktı almadan önce baskı ön izlemesini yapınız!", vbInformation, "KAYIT"
ThisWorkbook.Save
Unload Me
Application.Visible = True
Sheets("Tabela").Select
End Sub
makronun tamamı bu şekilde eksik yada fazla kısım olabilir deneme yanılma yoluyla yapmaya çalıştığım kodlar.

Düzeltme: makroda denemeye çalıştığım ikinci for each/next döngüsü birinci for each/next next'ten sonra idi makroda önce görünüyor.
 
Son düzenleme:
Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,986
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Merhaba.

Mevcut For each veri ..... Next döngüsünü sayfalar arasında gezdirmek için For sayfa = 1 To 2 ...Next
şeklinde bir döngü oluşturup, mevcut For each veri.... döngüsünü bu yeni döngünün içine alıp,
bu döngünün başlangıcında ve For each veri... döngüsüne girmeden önce
If sayfa=S1 Then alan=..... gibi bir satırla alan tanımlamasını yaparsanız istediğiniz olur gibi görünüyor.

Örnek belge olmadığından cevap da biraz afaki oluyor ama yapacak bir şey yok.
.
 
Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,986
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Tekrar merhaba.

Son cevabımla ilgili bir geri bildirim yok ama belirttiğim hususu aşağıdaki şekilde bir yapıyla gerçekleştirebilirsiniz.
Sayfalardaki işlemleri anlamadığımdan mecburen işlem kodları yok.
Aşağıdaki yapıda ilk For.....Next ile alan ve işlem yapılacak sayfa belirleniyor,
ikinci For.....Next bloku içerisinde de işlemleri kodlayabilirsiniz.
.
Rich (BB code): 
'................
For shf = 1 To 2
    If shf = 1 Then
        alan = "F3:F" & S1.Range("F65536").End(3).Row
        Set s = Sheets("Sayfa2")
    ElseIf shf = 2 Then
        alan = "A2:A" & S4.Range("A65536").End(3).Row
        Set s = Sheets("Menü")
    End If
        For Each Veri In s.Range(alan)
            '***** YAPILACAK İŞLEMLERE AİT KODLAR *****
        Next
Next
'................
 
T

__TR__

Katılım
29 Kasım 2008
Mesajlar
70
Excel Vers. ve Dili
Microsoft 2010
Merhaba Ömer hocam

İlk önerinizin üzerinde biraz uğraştım ancak tam anlamadığım ve yeterli olmadığımdan dolayı yapamadım. bir kaç deneme yanılmayla sanırım kulağımı tersten tutarak istediğimi yaptırabildim.
Makroda koyu olarak belirttiğim kısım üzerinde uğraştığım için konuya geri dönüş yapamadım kusura bakmayın. Belirttiğim kısım içinde Düşeyara veya indis formülünün makro hali gerekiyor. S3'ün (A) sütunundaki ürünlerin birim fiyatlarını, S1'in (D) sütunundan alıp S3'ün (L) sütununa yazacak, bu konuda bir yardımınız olursa sevinirim.

Kod: 
Private Sub CommandButton1_Click()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, S4 As Worksheet
Dim Veri As Range, Satır As Long
Dim i As Integer, s As Worksheet, son As Long
Dim txt As Control

Set S1 = Sheets("Ambar")
Set S2 = Sheets("Sayfa2")
Set S3 = Sheets("Tabela")
Set S4 = Sheets("Menü")
    
Application.ScreenUpdating = False
If TextBox1.Value = "" Then
MsgBox " Lütfen tüm alanları doldurunuz!", vbCritical, "UYARI!"
Exit Sub
End If

For Each Veri In S2.Range("F3:F" & S2.Range("F65536").End(3).Row)
If Veri.Value = CDate(TextBox1.Text) Then
If S2.Cells(Veri.Row, "E") <> "" Then
Satır = Satır + 1
    
S3.Cells(16 + Satır, "A") = S2.Cells(Veri.Row, "B")
S3.Cells(16 + Satır, "J") = S2.Cells(Veri.Row, "E")
S3.Cells(16 + Satır, "K") = S2.Cells(Veri.Row, "C")
S3.Cells(16 + Satır, "L") = S1.Cells(Veri.Row, "D")
End If
End If
Next

Set S3 = Sheets("Tabela")
Set S4 = Sheets("Menü")

For Each Veri2 In S4.Range("A2:A" & S4.Range("A65536").End(3).Row)
If Veri2.Value = CDate(TextBox1.Text) Then
If S2.Cells(Veri2.Row, "E") <> "" Then
  
S3.Range("J6") = S4.Cells(Veri2.Row, "B")
S3.Range("M6") = S4.Cells(Veri2.Row, "C")
S3.Range("P6") = S4.Cells(Veri2.Row, "D")
S3.Range("S6") = S4.Cells(Veri2.Row, "E")
End If
End If
Next
 
Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,986
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Tekrar merhaba.
Örnek belge üzerinde olmayınca afaki cevap yazmayı pek tercih etmiyorum.
Çünkü verilecek cevapların sorunu çözmeme/yeni sorunlar çıkartma ihtimali oldukça yüksek.
Kusura bakmayınız.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst