Soru Hücreye göre döngü alma

[Bahattin Sungur]

Arkadaslar merhaba, macroya yeni baslayanlardanim acemiyim baya. A1 hucresindeki değere göre sonuç verip b sütununa ( cevaba göre satır sayisi değişiyor 3 oluyor 5 oluyor vs.) yazıyor. Amacım makronun a1deki sonucu bulduktan sonra a2 ye geçmesi ve sonucu b sutununda devam ettirmesi. Örnek vermek gerekirse A1 sütununa değeri girdim b sütünü B1=1 b2=2 b3=3 sonucunu verdi daha sonra devam etti a2 deki sonuca göre b4=b b5=a vs.
Yardımlarınız için şimdiden teşekkürler.

 

[ÖmerFaruk]

Sorunuzu ve örnek çözümü, excel dosyasına işleyerek harici yükleme sitelerinden dosyanızı paylaşabilirsiniz.

 

[Bahattin Sungur]

SORULAR
Dosya burda rapora tıklarsanız makronun basit mantıgını anlarsınız zaten, amacım bunu iki tarih arasında yapabilmek, mesela 31.07.2021 ve 4.08.2021 tarihlerini girdiğim zaman, önce 31.07 bitince 01.08, 02.08, 03.08, 04.08 olarak hepsini alt alta yapması ve tek bir liste olarak çıkarması.

 

[Korhan Ayhan]

Makrolara yeni başladığınızı söylemişsiniz ama ADO yöntemini kullanmışsınız. Bunlar bir tık ileri seviye kodlamalardır.

Alternatif olarak aşağıdaki kodu deneyebilirsiniz. Ben de hızlı çalışması için dizi yöntemini kullandım.

Option Explicit

Sub RAPOR()
    Dim S1 As Worksheet, S2 As Worksheet, Veri As Variant
    Dim X As Long, Y As Integer, Say As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    
    S2.Range("D9:F" & S2.Rows.Count).ClearContents
        
    Veri = S1.Range("B1").CurrentRegion
    
    ReDim Liste(1 To UBound(Veri, 1) * UBound(Veri, 2), 1 To 3)
    
    For Y = LBound(Veri, 2) + 1 To UBound(Veri, 2)
        For X = LBound(Veri, 1) + 1 To UBound(Veri, 1)
            If Veri(1, Y) >= S2.Range("G6").Value And Veri(1, Y) <= S2.Range("H6").Value Then
                If Veri(X, Y) <> "" Then
                    Say = Say + 1
                    Liste(Say, 1) = Say
                    Liste(Say, 2) = Veri(X, 1)
                    Liste(Say, 3) = Veri(X, Y)
                End If
            End If
        Next
    Next
    
    If Say > 0 Then
        S2.Range("D9").Resize(Say, 3) = Liste
        With S2.Range("D8").Resize(Say + 1, 4)
            .Borders.LineStyle = 1
            .HorizontalAlignment = xlCenter
        End With
        MsgBox "İşleminiz tamamlanmıştır." & vbCr & vbCr & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Uygun kayıt bulunamadı!", vbExclamation
    End If
    
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[Bahattin Sungur]

Makrolara yeni başladığınızı söylemişsiniz ama ADO yöntemini kullanmışsınız. Bunlar bir tık ileri seviye kodlamalardır.

Alternatif olarak aşağıdaki kodu deneyebilirsiniz. Ben de hızlı çalışması için dizi yöntemini kullandım.

Option Explicit

Sub RAPOR()
    Dim S1 As Worksheet, S2 As Worksheet, Veri As Variant
    Dim X As Long, Y As Integer, Say As Long, Zaman As Double
   
    Zaman = Timer
   
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
   
    S2.Range("D9:F" & S2.Rows.Count).ClearContents
       
    Veri = S1.Range("B1").CurrentRegion
   
    ReDim Liste(1 To UBound(Veri, 1) * UBound(Veri, 2), 1 To 3)
   
    For Y = LBound(Veri, 2) + 1 To UBound(Veri, 2)
        For X = LBound(Veri, 1) + 1 To UBound(Veri, 1)
            If Veri(1, Y) >= S2.Range("G6").Value And Veri(1, Y) <= S2.Range("H6").Value Then
                If Veri(X, Y) <> "" Then
                    Say = Say + 1
                    Liste(Say, 1) = Say
                    Liste(Say, 2) = Veri(X, 1)
                    Liste(Say, 3) = Veri(X, Y)
                End If
            End If
        Next
    Next
   
    If Say > 0 Then
        S2.Range("D9").Resize(Say, 3) = Liste
        With S2.Range("D8").Resize(Say + 1, 4)
            .Borders.LineStyle = 1
            .HorizontalAlignment = xlCenter
        End With
        MsgBox "İşleminiz tamamlanmıştır." & vbCr & vbCr & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Uygun kayıt bulunamadı!", vbExclamation
    End If
   
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

Bu kodu da sitedeki bir arkadaşımiz yazdı sağolsun. Ben sadece onun verdiği koddan ayristirmalar basit düzeltmeleri yaptım. Verdiğiniz çözüm içinde teşekkür ederim sağolun.

 

[Bahattin Sungur]

Bu kodu da sitedeki bir arkadaşımiz yazdı sağolsun. Ben sadece onun verdiği koddan ayristirmalar basit düzeltmeleri yaptım. Verdiğiniz çözüm içinde teşekkür ederim sağolun.

kodu su anda denedim ama sadece uygun kayıt bulunamadı komutunu alıyorum. Kodunuzuda duzgun okuyamadım(cahilliğime verin lutfen ) bu yuzden acaba hata mı var diye check edemedim.

 

[Korhan Ayhan]

Paylaştığınız dosyanızda kodun çalışmasında sorun çıkıyor mu?

 

[Bahattin Sungur]

Paylaştığınız dosyanızda kodun çalışmasında sorun çıkıyor mu?

hayır kod herhangı bır hata vermıyor ama sürekli koda işlediğiniz "uygun kayıt bulunamadı" hatasını verıyor.

 

[ÖmerFaruk]

hayır kod herhangı bır hata vermıyor ama sürekli koda işlediğiniz "uygun kayıt bulunamadı" hatasını verıyor.

#3 nolu mesajınızdaki Dosyanızı indirdim ve çalıştırdım. Herhangi bir hata ya da Uygun Kayıt Bulunamadı şeklinde bir mesaj almadım.

Kullandığınız ADO yöntemiyle çalışan kodlarınızdaki aşağıdaki kısım belirttiğiniz mesajı verebilmektedir.
Buradaki mesaj "Girilen tarihe ait veri bulunmamaktadır!" dediğiniz mesajdır diye düşünüyorum.

If WorksheetFunction.CountIf(s1.[C1:G1], s2.[G6]) = 0 Then
    MsgBox "Girilen tarihe ait veri bulunmamaktadır!", vbInformation
    Exit Sub
Else

Sayfa2 de Başlangıç ve Bitiş tarihleri (G6 ve H6) belirttiğiniz halde yukarıdaki if sorgusunda sadece G6 hücresindeki başlangıç tarihine göre çalışmaktadır.

Sonuç olarak kodlarınız Başlangıç tarihini olarak belirtilen G6 hücresindeki tarihi baz alarak sayfa 1 de doğru şekilde arama ve sıralama yapabilmektedir.

 

[Bahattin Sungur]

#3 nolu mesajınızdaki Dosyanızı indirdim ve çalıştırdım. Herhangi bir hata ya da Uygun Kayıt Bulunamadı şeklinde bir mesaj almadım.

Kullandığınız ADO yöntemiyle çalışan kodlarınızdaki aşağıdaki kısım belirttiğiniz mesajı verebilmektedir.
Buradaki mesaj "Girilen tarihe ait veri bulunmamaktadır!" dediğiniz mesajdır diye düşünüyorum.

If WorksheetFunction.CountIf(s1.[C1:G1], s2.[G6]) = 0 Then
    MsgBox "Girilen tarihe ait veri bulunmamaktadır!", vbInformation
    Exit Sub
Else

Sayfa2 de Başlangıç ve Bitiş tarihleri (G6 ve H6) belirttiğiniz halde yukarıdaki if sorgusunda sadece G6 hücresindeki başlangıç tarihine göre çalışmaktadır.

Sonuç olarak kodlarınız Başlangıç tarihini olarak belirtilen G6 hücresindeki tarihi baz alarak sayfa 1 de doğru şekilde arama ve sıralama yapabilmektedir.

ben ustte arkadasın verdıgı kodu denedıgımde uygun kayıt bulunamadı hatası alıyorum. usttede anlatmıstım kodum tek tarihe gore işlem yapıyor amacım bu makroyu aralıga yaymak.

 

[ÖmerFaruk]

Korhan beyin verdiği kodlar Başlangıç ve Bitiş tarihlerini beraber sorguluyor.
Paylaştığınız dosyada bitiş tarihi 04.08.2021 yerine 04.07.2021 girildiği için sorgulama veri bulamıyor.
Bitiş tarihini 04.08.2021 yaparsanız kodla rişlem yapacaktır.