For ... Next döngüsünde Kod Hızlandırma

[tamer42]

Merhaba,
Ekli dosyada yer alan for next döngüsünün tamamının bitmesi çok uzun süre almakta;

bunu farklı bir yöntemle yapılabilme durumu olur mu acaba?

bu şekilde maalesef kullanışlı olmuyor.

farklı bir çözüm yönetmi arayışındayım

yardım ve yönlendirmeleriniz için şimdiden teşekkürler,
iyi günler.

Sub VeriList()
    Dim i As Byte, j As Byte
    Dim m1 As Byte, m2 As Byte

    Dim s1, s2, s3, s4, s5, s6, s7, s8
    Dim s9, s10, s11, s12, s13, s14, s15
    
    Dim zaman As Double
    Dim veri As Variant
    Dim arrData() As Variant
    Dim ss As Double
    Dim a As Byte
 
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    zaman = Timer
    
    Set SH = Sayfa1

    
    ReDim sayi(1 To 15)
    
    For i = 1 To 15
    
    m1 = SH.Cells(i + 1, 2).Value
    m2 = SH.Cells(i + 1, 3).Value
     
        say = m2 - m1 + 1
        ReDim veri(1 To say)
        a = 1
        For j = m1 To m2
            
                veri(a) = j
                a = a + 1

        Next j
        
        sayi(i) = veri

    Next i

   ss = 1
    
    SH.Activate
    

    For Each s15 In sayi(15)
         For Each s14 In sayi(14)
             For Each s13 In sayi(13)
                For Each s12 In sayi(12)
                    For Each s11 In sayi(11)
                        For Each s10 In sayi(10)
                            For Each s9 In sayi(9)
                                For Each s8 In sayi(8)
                                '    For Each s7 In sayi(7)
                                    '    For Each s6 In sayi(6)
                                        '    For Each s5 In sayi(5)
                                            '    For Each s4 In sayi(4)
                                               '     For Each s3 In sayi(3)
                                                   '     For Each s2 In sayi(2)
                                                       '     For Each s1 In sayi(1)

                                                         ''   ReDim Preserve arrData(ss)
                                                         ''       arrData(ss) = _
                                                                    Array(s15, s14, s13, _
                                                                        s12, s11, s10, _
                                                                        s9, s8, s7, _
                                                                        s6, s5, s4, _
                                                                        s3, s2, s1)
                                                                        
     ss = ss + 1
    Next: Next: Next: Next: Next: Next: Next: Next
    
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

 MsgBox "Aktarım işlemi tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - zaman, "0.00") & " Saniye", vbInformation
   
End Sub
[code]

 

[Muzaffer Ali]

Merhaba.
Eklediğiniz kodlar herhangi bir işlem yapmıyor.
Ama sanırım yapmak istediğinizi aşağıdaki kodlar ile yapabilirsiniz.

Sub test()
    Dim Bak As Long
    Dim Say As Long
    Dim Hcr As Range
    
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    Range("E2:E" & Say).Value = Range("B2:B" & Say).Value
    
    For Bak = 2 To Say
        Set Hcr = Range("F" & Bak & ":" & Cells(Bak, (Cells(Bak, "C") - Cells(Bak, "B")) + 5).Address)
        Hcr.Formula = "=E" & Bak & "+1"
        Hcr.Value = Hcr.Value
    Next
End Sub

 

[tamer42]

Merhaba.
Eklediğiniz kodlar herhangi bir işlem yapmıyor.
Ama sanırım yapmak istediğinizi aşağıdaki kodlar ile yapabilirsiniz.

Sub test()
    Dim Bak As Long
    Dim Say As Long
    Dim Hcr As Range
   
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    Range("E2:E" & Say).Value = Range("B2:B" & Say).Value
   
    For Bak = 2 To Say
        Set Hcr = Range("F" & Bak & ":" & Cells(Bak, (Cells(Bak, "C") - Cells(Bak, "B")) + 5).Address)
        Hcr.Formula = "=E" & Bak & "+1"
        Hcr.Value = Hcr.Value
    Next
End Sub

Muzaffer hocam teşekkürler,

iletmiş olduğum kod içinde "pasife aldığım" aşağıdaki işlemi yapacak aslında;

özetle her bir döngü içinden gelen değeri sırayla diziye atayacak

                                                      ''   ReDim Preserve arrData(ss)
                                                         ''       arrData(ss) = _
                                                                    Array(s15, s14, s13, _
                                                                        s12, s11, s10, _
                                                                        s9, s8, s7, _
                                                                        s6, s5, s4, _
                                                                        s3, s2, s1)
                                                                        
     ss = ss + 1

 

[Muzaffer Ali]

Eklediğim kod işinizi görmüyor mu?
Eğer işinizi görmüyorsa tam olarak ne yapmak istediğinizi söylerseniz belki daha kestirme bir yolu vardır.

 

[tamer42]

Eklediğim kod işinizi görmüyor mu?
Eğer işinizi görmüyorsa tam olarak ne yapmak istediğinizi söylerseniz belki daha kestirme bir yolu vardır.

Muzaffer Hocam sizin eklediğiniz kodda yer alan işlemleri ben önceden yapmıştım zaten, bunun bir adım ilerisi gerekiyor

Burada oluşan değerleri( ekli görsel) kullanarak kombinasyon listesi oluşturmak istiyordum.

teşekkürler,
iyi akşamlar.

 

[Muzaffer Ali]

Bunun uzun sürmesi gayet normal, çünkü milyonlarca kombinasyon var.

 

[tamer42]

Bunun uzun sürmesi gayet normal, çünkü milyonlarca kombinasyon var.

Muzaffer Hocam pratik bir çözüm olabilir mi? onu araştırıyorum
verileri bir collection içine falan alarak süre kısaltılabilir mi?

 

[Muzaffer Ali]

Dizinden daha hızlı bir yöntem yok diye biliyorum.

 

[tamer42]

Dizinden daha hızlı bir yöntem yok diye biliyorum.

her şey için teşekkür ederim Hocam
dictionary çözüm olmaz mı acaba?

 

[Muzaffer Ali]

her şey için teşekkür ederim Hocam
dictionary çözüm olmaz mı acaba?

Dizin daha hızlı.

 

[Tevfik_Kursun]

Gerçekten hızlı, teşekkürler