Çoklu For Next Döngüsü

[parcabakkal]

Merhaba;

Makrolar hakkında çok az bilgim var. Fakat ihtiyacım olan kodu ne bulabiliyorum ne de yazabiliyorum.

A2 Hücresindeki veriyi, hücrelerin boş olmaması şartıyla, A16 hücresindeki satır A18 hücresindeki sütündan başlayarak,A9 hücresi adedince yazıp ardından A11 hücresi adedince hücre atlama (aşağı doğru) olayını, A13 hücresindeki veri kadar tekrarla.

Örneğin; Kırmızı yazısını 5 kere yazıp ardından 15 hücre atlayıp altına 5 tane daha kırmızı yazacak yine 15 atlayacak ( olayı 2 kere tekrarlattığımızı varsayarsak )

Yardımlarınızı bekliyorum

Teşekkür ederim.

 

[YUSUF44]

Foruma hoş geldiniz.

Örnek excel dosyası paylaşmanızı öneririm.

 

[parcabakkal]

Foruma hoş geldiniz.

Örnek excel dosyası paylaşmanızı öneririm.

İlginiz için teşekkür ederim Yusuf Bey

Google Sheets: Sign-in

Access Google Sheets with a personal Google account or Google Workspace account (for business use).

docs.google.com

 

[YUSUF44]

Merhaba.

Erişim izni vermemişsiniz.

 

[parcabakkal]

Merhaba.

Erişim izni vermemişsiniz.

Merhaba Yusuf bey;
Erişimi düzelttim

 

[YUSUF44]

A15:E34 aralığı işleri karıştırıyor gördüğüm kadarıyla.

Yapmak istediğiniz 2 renk, 3 motor, 2 vites, 2 model ve 2 paket varyasyonlarının tümünün listesinin yapılması mı? Daha geniş olarak ise A2:E6 aralığında bulunan tüm dolu hücrelerin varyasyonlarının listelenmesi mi?

 

[EmrExcel16]

Merhaba , deneyiniz..

Sub Test()
    Dim i, x, y, z, sat, sut, adt, boslk, tekr
    For i = 1 To 5
        For x = 2 To 6
            If Cells(x, i) <> "" Then
                sat = Cells(x * 4 + 8, i)
                sut = Cells(x * 4 + 10, i)
                adt = Cells(9, i)
                boslk = Cells(11, i)
                tekr = Cells(13, i)
                For y = 1 To tekr
                    For z = 1 To adt
                        Cells(sat + (boslk + adt) * y - (boslk + adt) + z, sut) = Cells(x, i)
                    Next
                Next
            End If
        Next
    Next
End Sub

 

[YUSUF44]

Eğer istediğiniz bir önceki mesajımda belirttiğim gibiyse aşağıdaki makroyu deneyiniz:

Sub varyasyon()
eski = Cells(Rows.Count, "H").End(3).Row
Range("H1:P" & eski).ClearContents
renks = WorksheetFunction.CountA([A1:A6])
motors = WorksheetFunction.CountA([B1:B6])
vitess = WorksheetFunction.CountA([C1:C6])
models = WorksheetFunction.CountA([D1:D6])
pakets = WorksheetFunction.CountA([E1:E6])
sat = 1
For renk = 2 To renks
    For motor = 2 To motors
        For vites = 2 To vitess
            For yil = 2 To models
                For paket = 2 To pakets
                    Cells(sat, "H") = Cells(renk, "A")
                    Cells(sat, "J") = Cells(motor, "B")
                    Cells(sat, "L") = Cells(vites, "C")
                    Cells(sat, "N") = Cells(yil, "D")
                    Cells(sat, "P") = Cells(paket, "E")
                    sat = sat + 1
                Next
            Next
        Next
    Next
Next                   
End Sub

 

[parcabakkal]

Merhaba , deneyiniz..

Sub Test()
    Dim i, x, y, z, sat, sut, adt, boslk, tekr
    For i = 1 To 5
        For x = 2 To 6
            If Cells(x, i) <> "" Then
                sat = Cells(x * 4 + 8, i)
                sut = Cells(x * 4 + 10, i)
                adt = Cells(9, i)
                boslk = Cells(11, i)
                tekr = Cells(13, i)
                For y = 1 To tekr
                    For z = 1 To adt
                        Cells(sat + (boslk + adt) * y - (boslk + adt) + z, sut) = Cells(x, i)
                    Next
                Next
            End If
        Next
    Next
End Sub

Çok teşekür ederim sıkıntısız çalışıyor. Ben buna herhalde 1 sene uğraşırdım. Hayırlı günler diliyorum.

 

[parcabakkal]

Eğer istediğiniz bir önceki mesajımda belirttiğim gibiyse aşağıdaki makroyu deneyiniz:

Sub varyasyon()
eski = Cells(Rows.Count, "H").End(3).Row
Range("H1:P" & eski).ClearContents
renks = WorksheetFunction.CountA([A1:A6])
motors = WorksheetFunction.CountA([B1:B6])
vitess = WorksheetFunction.CountA([C1:C6])
models = WorksheetFunction.CountA([D1:D6])
pakets = WorksheetFunction.CountA([E1:E6])
sat = 1
For renk = 2 To renks
    For motor = 2 To motors
        For vites = 2 To vitess
            For yil = 2 To models
                For paket = 2 To pakets
                    Cells(sat, "H") = Cells(renk, "A")
                    Cells(sat, "J") = Cells(motor, "B")
                    Cells(sat, "L") = Cells(vites, "C")
                    Cells(sat, "N") = Cells(yil, "D")
                    Cells(sat, "P") = Cells(paket, "E")
                    sat = sat + 1
                Next
            Next
        Next
    Next
Next                  
End Sub

Yusuf Bey ilginiz için teşekkür ederim. Kod 2. sırada hata veriyor. Emre beyinki şuanda işimi görüyor. Sizinki benim hesaplattığım değişkenlere bağlı olmadan çalışıyor. Tekrar kontrol ederseniz mutlu olurum. İlerde seçimi genişletirsem kullanabilirim.

 

[YUSUF44]

Örnek dosyanızda makro düzgün çalışıyor. Ayrıca verdiğim makro A2:E6 arasındaki dolu hücrelere göre işlem yapıyor. Yani örneğin model ya da renk sayısı değişirse de işlem yapacak şekilde ayarladım. Makro, örnek dosyanızda yer alan sonucun birebir aynısını oluşturmaktadır.

Araç model listeleme.xlsm

drive.google.com

 

[parcabakkal]

Örnek dosyanızda makro düzgün çalışıyor. Ayrıca verdiğim makro A2:E6 arasındaki dolu hücrelere göre işlem yapıyor. Yani örneğin model ya da renk sayısı değişirse de işlem yapacak şekilde ayarladım. Makro, örnek dosyanızda yer alan sonucun birebir aynısını oluşturmaktadır.

Araç model listeleme.xlsm

drive.google.com

Evet düzgün çalışıyor. Bende hata varmış. Bir ricam daha olacak. En sondaki sütüna veri girişi olmadığında makro çalışmıyor. Bazı durumlarda son süunu kullanmamazı gerekiyor.

 

[YUSUF44]

Deneyiniz:

Sub varyasyon()
eski = Cells(Rows.Count, "H").End(3).Row
Range("H1:P" & eski).ClearContents
renks = WorksheetFunction.CountA([A1:A6])
motors = WorksheetFunction.CountA([B1:B6])
vitess = WorksheetFunction.CountA([C1:C6])
models = WorksheetFunction.CountA([D1:D6])
pakets = WorksheetFunction.CountA([E1:E6])
sat = 1
If pakets >= 2 Then
    For renk = 2 To renks
        For motor = 2 To motors
            For vites = 2 To vitess
                For yil = 2 To models
                    For paket = 2 To pakets
                        Cells(sat, "H") = Cells(renk, "A")
                        Cells(sat, "J") = Cells(motor, "B")
                        Cells(sat, "L") = Cells(vites, "C")
                        Cells(sat, "N") = Cells(yil, "D")
                        Cells(sat, "P") = Cells(paket, "E")
                        sat = sat + 1
                    Next
                Next
            Next
        Next
    Next
Else
    For renk = 2 To renks
        For motor = 2 To motors
            For vites = 2 To vitess
                For yil = 2 To models
                    Cells(sat, "H") = Cells(renk, "A")
                    Cells(sat, "J") = Cells(motor, "B")
                    Cells(sat, "L") = Cells(vites, "C")
                    Cells(sat, "N") = Cells(yil, "D")
                    sat = sat + 1
                Next
            Next
        Next
    Next
End If
End Sub

 

[parcabakkal]

Teşekkür ederim. Elinize sağlık. Allah razı olsun.