Excel'de Hesap Planı Oluşturma

[umit1907]

Merhabalar logo programı için excelde 7 kırılımlı bir hesap planı oluşturmamız gerekiyor (5-6 şube olduğu için 7 kırılım) hesap kodları oluştururken üst hesabın açılıp açılmadığını kontrol edebilirmiyiz.Ekte bir örnek dosya vasıtasıyla anlatmaya çalıştım yardımlarınız için şimdiden teşekkürler.

 

[Ömer]

Merhaba,

Bu şekilde deneneyiniz. Eksik kodları B sütununa listeler.

Yalnız A sütununu önce metin formatına çevirin sonra verileri girin, çünkü verileri görsel olarak değil biçim olarak nokta ile girmeniz gerekir.
Örnek olarak A2 hücresindeki veriyi 100001 olarak girmişsiniz. Bunu önlemek için A sütununu metin olarak biçimlendirin ve verileri girerken nokta simgesini kullanın. 100.001 gibi.

Sub HesapKontrol()
 
    Dim i As Long, sat As Long, a As String, b As String
    Dim j As Integer, c As Range, d
 
    Application.ScreenUpdating = False
 
    With Range("B:B")
        .ClearContents
        .NumberFormat = "@"
    End With
 
    sat = 1
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        d = Split(Cells(i, "A"), ".")
        a = "": b = ""
        For j = 0 To UBound(d) - 1
            a = a & "." & d(j)
            b = WorksheetFunction.Substitute(a, ".", "", 1)
            Set c = [A:A].Find(b, , xlValues, xlWhole)
            If c Is Nothing Then
                Cells(sat, "B") = b
                sat = sat + 1
            End If
        Next j
    Next i
 
    Application.ScreenUpdating = True
 
End Sub

 

[turist]

Merhaba,

Bu şekilde deneneyiniz. Eksik kodları B sütununa listeler.

Yalnız A sütununu önce metin formatına çevirin sonra verileri girin, çünkü verileri görsel olarak değil biçim olarak nokta ile girmeniz gerekir.
Örnek olarak A2 hücresindeki veriyi 100001 olarak girmişsiniz. Bunu önlemek için A sütununu metin olarak biçimlendirin ve verileri girerken nokta simgesini kullanın. 100.001 gibi.

Sub HesapKontrol()
 
    Dim i As Long, sat As Long, a As String, b As String
    Dim j As Integer, c As Range, d
 
    Application.ScreenUpdating = False
 
    With Range("B:B")
        .ClearContents
        .NumberFormat = "@"
    End With
 
    sat = 1
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        d = Split(Cells(i, "A"), ".")
        a = "": b = ""
        For j = 0 To UBound(d) - 1
            a = a & "." & d(j)
            b = WorksheetFunction.Substitute(a, ".", "", 1)
            Set c = [A:A].Find(b, , xlValues, xlWhole)
            If c Is Nothing Then
                Cells(sat, "B") = b
                sat = sat + 1
            End If
        Next j
    Next i
 
    Application.ScreenUpdating = True
 
End Sub

Sn. Ömer Hocanın yaptıklarına ufak eklentilerle bir dosya oluşturdum.
Sizin verdiğiniz örnekleri geliştirmek adına bir çalışmadır.Eksik ve yanlışlarım varsa şimdiden özür dilerim.

Kolay gelsin.

 

[umit1907]

süpersiniz abiler elinize sağlık

 

[Ömer]

Sn. Ömer Hocanın yaptıklarına ufak eklentilerle bir dosya oluşturdum.
Sizin verdiğiniz örnekleri geliştirmek adına bir çalışmadır.Eksik ve yanlışlarım varsa şimdiden özür dilerim.

Kolay gelsin.

Sayın turist, sanırım mükerrer verileri eklemek için ilave yaptınız.

Haklısınız ben bu kısmı atlamışım. Alternatif olarak, #2 numaralı mesajda eklediğim kodlardaki;

Set c = [A:A].Find(b, , xlValues, xlWhole)

Yukarıdaki satırı aşağıdaki gibi değiştirmeniz yeterli olacaktır.

Set c = [A:B].Find(b, , xlValues, xlWhole)

.