• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Çoklu For Next Döngüsü

P

parcabakkal

Katılım
20 Mart 2022
Mesajlar
7
Excel Vers. ve Dili
excel 2016
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.
 
Foruma hoş geldiniz.

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

Erişim izni vermemişsiniz.
 
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?
 
Merhaba , deneyiniz..

Kod: 
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
 
Eğer istediğiniz bir önceki mesajımda belirttiğim gibiyse aşağıdaki makroyu deneyiniz:

PHP: 
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
 
EmrExcel16' Alıntı:
Merhaba , deneyiniz..

Kod: 
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
Genişletmek için tıkla ...
Ç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.
 
YUSUF44' Alıntı:
Eğer istediğiniz bir önceki mesajımda belirttiğim gibiyse aşağıdaki makroyu deneyiniz:

PHP: 
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
Genişletmek için tıkla ...
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.
 
Ö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 drive.google.com
 
YUSUF44' Alıntı:
Ö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 drive.google.com
Genişletmek için tıkla ...
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.
 
Deneyiniz:

PHP: 
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
 
Teşekkür ederim. Elinize sağlık. Allah razı olsun.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst