muavin düzenleme

[umit1907]

Merhabalar,
Ekteki dosyada ilk boşluktaki hesap numaralarını almak istiyorum.

 

[Korhan Ayhan]

İnceleyiniz.

 

[umit1907]

Eline sağlık abi. aynen bunun gibi istediğim ama dosya çok uzun formül biraz kasıyor.

 

[umit1907]

Çok kitleniyor abi makrolu bir çözüm olabilirmi.

 

[maliex]

Sub DENEME()

Dim s1 As Worksheet
Set s1 = Sheets("Ana Hesap Kebir")

ss1 = s1.Cells(s1.Rows.Count, 1).End(3).Row

For X = 1 To ss1

    If s1.Cells(X, "B").Value Like "*Ana Hesap Kodu:*" Then

    Ana_Hesap_Kodu = WorksheetFunction.Substitute(s1.Cells(X, "B"), "Ana Hesap Kodu: ", "")
    Ana_Hesap_ADI = WorksheetFunction.Substitute(s1.Cells(X, "D"), "Ana Hesap Adı: ", "")
    Alt_Hesap_Kodu = WorksheetFunction.Substitute(s1.Cells(X + 1, "C"), "Alt Hesap Kodu: ", "")
    Alt_Hesap_Adı = WorksheetFunction.Substitute(s1.Cells(X + 1, "E"), "Alt Hesap Adı: ", "")
    

        For Q = X + 3 To 1000000
    
            If IsDate(s1.Cells(Q, "A")) Then
        
                s1.Cells(Q, "H") = Ana_Hesap_Kodu
                s1.Cells(Q, "I") = Ana_Hesap_ADI
                s1.Cells(Q, "J") = Alt_Hesap_Kodu
                s1.Cells(Q, "K") = Alt_Hesap_Adı
                
            Else
                X=Q-1
                Exit For
            End If
        
        Next Q
    
    End If

Next X


End Sub

 

[umit1907]

çok teşekkürler elinize sağlık.

 

[maliex]

Rica ederim kodda ufak bi güncelleme yaptım daha hızlı çalışır..kolay gelsin