Dikey ve Yatay döngülü makronun aynı anda kullanımı.

[Carpintero]

Merhaba arkadaşlar. Başlıkta da belirttiğim gibi her iki döngüyü koşul da ekleyerek
kullanmak üzere bir makro ihtiyacım var. Örnek dosya da elimden geldiği kadar
açıklama yapmaya çalıştım. Umarım bilgiler ışığında yardımcı olabilir siniz.
Konuya hakim değerli arkadaşlarımın yardımını bekliyorum teşekkür ederim.

İndir yatay sütun

Dosyayı indir yatay sütun

dosya.co

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Tablo_Hazirla()
    Dim S1 As Worksheet, Veri As Variant, Son As Long, Sutun As String, Satir As Long
    Dim A As Long, B As Long, C As Long, D As Integer, E As Long, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sayfa1")
    
    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    If Son = 4 Then Son = 5
    
    Sutun = Replace(S1.Cells(2, S1.Columns.Count).End(1).Address(0, 0), 2, "")
    Veri = S1.Range("B2:" & Sutun & Son).Value
    
    ReDim Liste(1 To UBound(Veri, 1), 1 To UBound(Veri, 2) - 6)
    
    S1.Range("H4:" & Sutun & Rows.Count).ClearContents
    
    For A = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(A, 1) <> "" Then
            For B = A To UBound(Veri, 1)
                If Veri(A, 1) = Veri(B, 1) Then
                    Satir = B
                Else
                    Exit For
                End If
            Next

            For C = A To Satir
                For D = LBound(Veri, 2) + 6 To UBound(Veri, 2)
                    If Veri(C, 4) = Veri(1, D) Then
                        For E = A To Satir
                            Liste(E - 2, D - 6) = Veri(C, 3)
                        Next
                        GoTo 10
                    End If
                Next
10          Next
        A = C - 1
        End If
    Next
    
    S1.Range("H4").Resize(UBound(Veri, 1), UBound(Veri, 2) - 6) = Liste
    
    Set S1 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[Carpintero]

Sayın hocam çok teşekkür ederim.
Her zaman ki gibi döktürmüş sünüz yine.

Dosyanın küçültülmüş halini yüklemiştim. Satır sayısı veriler arasındaki boşluklar, veri adresleri vs
çok çok farklı durumda. Dosyanın gerçek hali çok karışık olduğu için ancak bu örneği
çıkartabildim. Diyeceğim o ki. Bu makro kalmak kaydı ile.
Biz acemilerin de revize edebileceği klasik döngüler ile bu işi yapma durumumuz var mı
acaba ? Zaman sıkıntım yok. Müsait olduğunuz bir anda da olsa olur.

atıyorum

for yatay = 8 to 16
(bu sarı zeminli verilerin alanı)

for dikey=4 to 18
bu da diğer verilerin alanı.

bu iki döngüyü karşılaştırarak yapabilinecek bir makroyu
kendim revize edebilirim diye düşünüyorum.

 

[Korhan Ayhan]

Merhaba,

Zaten önerdiğim kod klasik döngülerden oluşuyor. (A-B-C-D-E toplam 5 adet döngü var.)

Tabiri caizse lütfen asıl dosyanıza uygun satır ve sütun bakımından örnek dosya paylaşınız demekten dilimizde tüy bitti.

Bu durumu sürekli olarak tekrar etmekten gerçekten çok sıkıldım. (Size has bir durum değil...)

Eğer öğrenmek istiyorsanız boş dosyalarda basit verilerle bol bol pratik yaparak çalışmanızı tavsiye ederim. Forumda bolca örnek zaten var. Forumdaki cevapların neredeyse %80'i döngülerle ilgili cevaplardır. Arama yaparsanız ve zaman ayırırsanız kolayca öğrenebilirsiniz.