faturaya otomatik sıra numarası atama

[merve.dinc]

Merhaba arkadaşlar ekteki dosyanın 1. sayfasında fatura 2. sayfasında ise firmalar ve bilgileri bulunmaktadır. Şirket adını açılır listeden aldırıp telefon ve adres bilgilerini düşeyara ile otomatik getirttim fakat;
Her bir şirket için 1den başlamak üzere fatura numarası oluştursun istiyorum.Yani bu taslağa ilk girdiğimde 1. şirket için bana fatura numarasını 00001 olarak verecek 1. şirket için 2. defa girdiğimde fatura numarasını 00002 olarak verecek.2.şirket için ilk faturayı girdiğimde yine 00001 numarasını verecek bir makro oluşturmak istiyorum.VBA de denedim fakat işin içinden çıkamadım yardımcı olursanız çok sevinirim.

 

[Necdet]

Merhaba,

Aşağıdaki kodları "Satış Faturası" sayfasının kod bölümüne kopyalayınız.

Sayfa1 de D sütununda her faturanın numarasının takibi için bir sütun açtım. Firmalar için kaldığı numaraları buraya yazmalısınız. Yazmazsanız her firma için ilk değişiklikte 1 numarası alacaktır.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [B11]) Is Nothing Then Exit Sub
    
    Dim c As Range
    Dim s1 As Worksheet
    
    Set s1 = Sheets("Sayfa1")
    
    Set c = Sheets("Sayfa1").Range("A:A").Find(Target.Value, LookIn:=xlValues, Lookat:=xlWhole)
    If Not c Is Nothing Then
        s1.Cells(c.Row, "D") = s1.Cells(c.Row, "D") + 1
        [B9] = s1.Cells(c.Row, "D")
    Else
        MsgBox "Firma TANIMLI DEĞİL....", vbCritical
        Exit Sub
    End If
End Sub

 

[merve.dinc]

Çok teşekkür ederim,ellerinize sağlık tam 1 gündür bununla uğraşıyordum

 

[Necdet]

Güle güle kullanınız.