• DİKKAT

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

Döngü sorunu

U

unfors

Katılım
30 Ekim 2010
Mesajlar
108
Excel Vers. ve Dili
2007 Türkçe
Kod: 
Private Sub CommandButton15_Click()


Set sht = Sheets("HAMMADDE_LİSTESİ")
ss = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
For kk = 7 To ss

LastRow = Cells.Find(What:="#", After:=Cells(kk, 1), SearchOrder:=xlRows, SearchDirection:=xlPrevious).Row
Nextrow = Cells.Find(What:="#", After:=Cells(kk, 1), SearchOrder:=xlRows, SearchDirection:=xlNext).Row


cnt = Range("A" & LastRow & ":A" & Nextrow).Rows.Count

For i = 1 To cnt


ery = Cells(LastRow, 2).Value


If Range("A" & kk).Value <> "#" Then

Range("A" & kk).Value = Left(Range("N" & kk).Value, 1) & "." & Left(Range("M" & kk).Value, 1) & "." & Right(ery, 4) & "." & 1000 + i
End If

Next
Next
End Sub

Yukarıdaki kod ile "#" ile başlayan satırların sonunda her grup için ne kadar satır varsa sayıp .1001 .1002 gibi kod oluşturmasını istiyorum. Hata nerde bulamıyorum?
 
Üstadlar bir el atsanızda sabaha kadar 3000 satır yazmasak
 
Kodları aşağıdaki şekilde kullanabilirsiniz ancak verilerinizin çokluğuna göre döngü uzun sürebilir:

Kod: 
Private Sub CommandButton1_Click()
son = Cells(Rows.Count, "A").End(3).Row
a = 1001
For i = 3 To son
    b = 1001
    If Cells(i, "A") = "#" Then
        For j = i + 1 To son
            If Cells(j, "A") <> "#" Then
                Cells(j, "K") = "A.P." & a & "." & b
                b = b + 1
            End If
        Next
    a = a + 1
    End If
Next

End Sub
 
Geceyi kurtardınız valla YUSUF44. Çok teşekkür ederim. Kodu hala anlamaya çalışıyorum bu arada
 
Kod çok basit aslında, içiçe iki döngü.

son ile son dolu satır numarasını buluyoruz.

Sayılı kodların ilk bölümü için "a" değişkenini kullanacağımızdan a'ya başlangıç numarası olarak 1001 veriyoruz.

İlk for next döngüsünde i değişkenine 3'ten (ilk satırımız) son satır numarasına kadar sırayla numara verdiriyoruz.

Sayılı kodların ikincisi için b değişkenine başlangıç değeri olarak 1001 veriyoruz.

İf koşuluyla A sütunun i satırındaki değerin # olup olmadığını kontrol ediyoruz, # ise altta verilen işlemi yaptıracağız.

Bu sefer ikinci for next döngüsüyle j değişkenine i'nin bir fazlasından son'a kadar değer veriyoruz. i satırından sonrasını kontrol ediyoruz çünkü # satırından sonraki satırları kontrol etmemiz gerekiyor.

İkinci if satırıyla eğer j satırının A hücresindeki değer # değilse belirttiğinzi kurala göre K sütununa kod veriyoruz.

O satırın işlemi bitince b değerini 1 arttırıyoruz ki sonraki satırda doğru kodu verebilelim.

Bu for next döngüsü son satıra kadar kontrol ediyor. Burda aslında hata yapmışım, kod doğru çalışıyor ama verilerin çokluğuna göre çalışma süresi uzuyor. Uzamaması için j değeri A sütununda # değerini gördüğünde döngüyü durdurması gerekiyor. bunun için kodu aşağıda verdiğim şekilde değiştirdim. Muhtemelen çok daha hızlı bitecektir.

Bu kontrol bitince a değerini 1 arttırıyoruz ki kodumuz yeni değer için düzelsin. diğer satırlar ise daha önce başlatılan döngüleri sonlandırma satırları.

Kodun son hali:

Kod: 
Private Sub CommandButton1_Click()
son = Cells(Rows.Count, "A").End(3).Row
a = 1001
For i = 3 To son
    b = 1001
    If Cells(i, "A") = "#" Then
        For j = i + 1 To son
            If Cells(j, "A") <> "#" Then
                Cells(j, "K") = "A.P." & a & "." & b
                b = b + 1
            Else
                j = son
            End If
        Next
    a = a + 1
    End If
Next

End Sub
 
Aşağıdaki gibi daha hızlı olacaktır:

Kod: 
Private Sub CommandButton1_Click()
son = Cells(Rows.Count, "A").End(3).Row
a = 1001
For i = 3 To son
    b = 1001
    If Cells(i, "A") = "#" Then
        For j = i + 1 To son
            If Cells(j, "A") <> "#" Then
                Cells(j, "K") = "A.P." & a & "." & b
                b = b + 1
            Else
                i = j - 1
                j = son
            End If
        Next
    a = a + 1
    End If
Next

End Sub
 
Kod: 
Private Sub CommandButton1_Click()

Son = Cells(Rows.Count, "A").End(3).Row

For i = 2 To Son

LastRow = Cells.Find(What:="#", After:=Cells(i, 1), SearchOrder:=xlRows, SearchDirection:=xlPrevious).Row
a = Left(Cells(LastRow, 2).Value, 4)
    b = 1001
    If Cells(i, "A") = "#" Then
        For j = i + 1 To Son
            If Cells(j, "A") <> "#" Then
                Cells(j, "A") = Left(Cells(j, "F"), 1) & "." & Left(Cells(j, "G"), 1) & "." & a & "." & b
                b = b + 1
            End If
        Next
   
    End If
Next


End Sub

Kodu yukarıdakine dönüştürdüm ama hep bir alt satırda işlem yapıyor

Kod: 
LastRow = Cells.Find(What:="#", After:=Cells(i, 1), SearchOrder:=xlRows, SearchDirection:=xlPrevious).Row

bunda mı bir sıkıntı var
 
Amacım sizin "a" değişkenini "#" ile başlayan kendinden üstteki satırdan alması. Herzaman sıralı gitmiyor çünkü ama nedense ya bir altı yada bir üstü alıyor!
 
Son düzenleme:
Aşağıdaki gibi deneyin:

Kod: 
Private Sub CommandButton1_Click()
son = Cells(Rows.Count, "A").End(3).Row
For i = 3 To son
    b = 1001
    If Cells(i, "A") = "#" Then
        a = Left(Cells(i, "B"), 4) * 1
        For j = i + 1 To son
            If Cells(j, "A") <> "#" Then
                Cells(j, "K") = "A.P." & a & "." & b
                b = b + 1
            Else
                i = j - 1
                j = son
            End If
        Next
    End If
Next

End Sub
 
YUSUF44 gerçekten elinize emeğinize sağlık. Üstad Mükemmel oldu vallahi. Tekrar çok teşekkür ederim
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst