Soru Sayfalardan koşula bağlı veri çekme

[Ceolwsy]

Burda ufak bi hata alıyorum fakat ben

Merhabalar teşekkür ederim öncelikle hayırlı bayramlar sizede. Kodlar çalışıyor çok teşekkürler If syf.Cells(c.Row, "H") = 1 Then burada aralık belirtmek istersem nasıl düzenleyebilirim yani ben direkt H29 ile H49 arası demek istiyorum. Raporumun orijinalinde size attığım tüm sütunlar 29 ile 49. satır arasında yer alıyor. Range ile yapmaya çalıştım fakat hata alıyorum

Verilerin arandığı aralıktan mı bahsediyorsunuz.

Kodlarda;
Set c = syf.[D: D].Find(S1.Cells(i, "A"), , xlValues, xlWhole)
.
.
.
Set c = syf.[D: D].FindNext(c)

Yukarıda iki satırdaki [D: D] yerine [D29: D49] yazmanız yeterli olacaktır.

.

Evet ben diğer sütunları da değiştirmeye çalıştım hata aldım fakat sadece D'leri dediğiniz gibi düzeltince hiç sorun kalmadı elinize emeğinize sağlık kod tüm sayfalarda çalışıyor başta bahsettiğiniz hata verme olayını çözmeye çalışacağım sadece. Tekrardan çok teşekkür ederim

 

[Ömer]

Hatayı nerede alıyorsunuz. Hata aldığınız dosyayı ekleyip açıklarsanız yardımcı olmaya çalışırım.

 

[Ceolwsy]

Hatayı nerede alıyorsunuz. Hata aldığınız dosyayı ekleyip açıklarsanız yardımcı olmaya çalışırım.

Herhangi bi hata almiyorum kod sorunsuz çalışıyor teşekkürler

 

[Ömer]

başta bahsettiğiniz hata verme olayını çözmeye çalışacağım sadece.

Buradaki mesajınızdan dolayı hata alıyorsunuz algılamıştım.

İşinize yaradığına sevindim. İyi çalışmalar.

 

[Ceolwsy]

Buradaki mesajınızdan dolayı hata alıyorsunuz algılamıştım.

İşinize yaradığına sevindim. İyi çalışmalar.

Teşekkür ederim orada bahsettiğim olay aynı duruma 2 farklı tarih atanması durumunda hatalı girişin yapıldığını göstermeyi istediğim koddu. Onunla alakalı tüm tarih atamalarinin boş hücrelere yapılmasını eğer hücre daha önceden başka bı tarih ile atandiysa yani doluysa mesaj olarak hata vermesi. Bunun üzerine araştırma yapacağım nasıl ekleyebilirim diye. Her şey için çok teşekkürler

 

[Ömer]

Evet, o şart net olmadığı için sonraya bırakmıştım.
Mesajları kod çalıştığı esnada tek tek verdirirseniz işlevsellik açısından size zahmet vereceği için toplu olarak sona ekledim.
Bu şekilde değil de farklı bir kurgu düşünürseniz ona göre de ilerleyebiliriz.

Sub rapor_coklu()

    Dim S1 As Worksheet, syf As Worksheet, i As Long, c As Range, Adr As String, j As Byte
    Dim m1 As String, m2 As String, m3 As String

    Set S1 = Sheets("özet")

    Application.ScreenUpdating = False
    S1.Range("B3:H" & Rows.Count).ClearContents

    For j = 2 To 8
        For i = 3 To S1.Cells(Rows.Count, "A").End(xlUp).Row
       
            For Each syf In ThisWorkbook.Worksheets
                If Left(syf.Name, 2) > 0 And Left(syf.Name, 2) < 32 Then

                    Set c = syf.[D29:D49].Find(S1.Cells(i, "A"), , xlValues, xlWhole)
                    If Not c Is Nothing Then
                        Adr = c.Address
                        Do
                            If syf.Cells(c.Row, "H") = 1 Then
                                If syf.Cells(c.Row, "B") = S1.Cells(2, j) Then
                                    If S1.Cells(i, j) = "" Then
                                        S1.Cells(i, j) = syf.Cells(c.Row, "A")
                                    Else
                                        m1 = m1 & " | " & syf.Name
                                        m2 = m3 & " | " & S1.Cells(i, "A")
                                        m3 = m3 & " | " & S1.Cells(2, j)
                                    End If
                                End If
                            End If
                            Set c = syf.[D29:D49].FindNext(c)
                        Loop While Not c Is Nothing And c.Address <> Adr
                    End If
                End If
            Next syf
           
        Next i
    Next j

    S1.Select
 
    If m1 <> "" Then
        MsgBox "Sayfa: " & m1 & " | " & vbLf & "Category: " & m2 & " | " _
        & vbLf & "Wtg No: " & m3 & " | " & vbLf & vbLf _
        & "Verileri Hücreler Dolu Olduğu İçin Kayıt Edilmedi.", vbInformation
    End If
 
    Application.ScreenUpdating = True

End Sub

 

[Ceolwsy]

Evet, o şart net olmadığı için sonraya bırakmıştım.
Mesajları kod çalıştığı esnada tek tek verdirirseniz işlevsellik açısından size zahmet vereceği için toplu olarak sona ekledim.
Bu şekilde değil de farklı bir kurgu düşünürseniz ona göre de ilerleyebiliriz.

Sub rapor_coklu()

    Dim S1 As Worksheet, syf As Worksheet, i As Long, c As Range, Adr As String, j As Byte
    Dim m1 As String, m2 As String, m3 As String

    Set S1 = Sheets("özet")

    Application.ScreenUpdating = False
    S1.Range("B3:H" & Rows.Count).ClearContents

    For j = 2 To 8
        For i = 3 To S1.Cells(Rows.Count, "A").End(xlUp).Row
      
            For Each syf In ThisWorkbook.Worksheets
                If Left(syf.Name, 2) > 0 And Left(syf.Name, 2) < 32 Then

                    Set c = syf.[D29:D49].Find(S1.Cells(i, "A"), , xlValues, xlWhole)
                    If Not c Is Nothing Then
                        Adr = c.Address
                        Do
                            If syf.Cells(c.Row, "H") = 1 Then
                                If syf.Cells(c.Row, "B") = S1.Cells(2, j) Then
                                    If S1.Cells(i, j) = "" Then
                                        S1.Cells(i, j) = syf.Cells(c.Row, "A")
                                    Else
                                        m1 = m1 & " | " & syf.Name
                                        m2 = m3 & " | " & S1.Cells(i, "A")
                                        m3 = m3 & " | " & S1.Cells(2, j)
                                    End If
                                End If
                            End If
                            Set c = syf.[D29:D49].FindNext(c)
                        Loop While Not c Is Nothing And c.Address <> Adr
                    End If
                End If
            Next syf
          
        Next i
    Next j

    S1.Select

    If m1 <> "" Then
        MsgBox "Sayfa: " & m1 & " | " & vbLf & "Category: " & m2 & " | " _
        & vbLf & "Wtg No: " & m3 & " | " & vbLf & vbLf _
        & "Verileri Hücreler Dolu Olduğu İçin Kayıt Edilmedi.", vbInformation
    End If

    Application.ScreenUpdating = True

End Sub

Tam olarak düşündüğüm şeyi yapmışşınız emeğinize sağlık teşekkürler.