Dolu hücreye göre sıra no verme

[muhammetozgen]

ANA MENÜ İÇİN TIKLAYIN A BASINCA AÇILAN FORMDA UYE GİRİŞİ FORMU AÇILIP BİLGİLER DOLDURULUP YENİ KAYIT DEĞİNCE BİLGİLER VERİ SAYFASINA AKTARILIYOR ANCAK A STUNUNA SIRA NO YAZACAK AMA B STUNUNA İSE UYEMİ SORUSU EVET İSE UYE NO VERSİN HAYIRSA BOŞ GEÇSİN A STUNU SIRASI HER DURUMDADA DEVAM ETSİN BAŞKA DÜZELTME VE İYİLESTIRMEDE YAPMAK İSTIYORUM ASLINDA UGRAŞIYORUM ŞİÇİNDEN ÇIKAMADIĞIM SORUNLARDA YARDIMLARINIZA İHTİYACIM OLACAK ŞİMDİDEN TEŞEKKÜRLER

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu yeni kayıt yapan butonunuzun altındaki kodların sonuna uygulayın.

"Yeni kayıt yapılmıştır." mesajının bir üstüne uygulayabilirsiniz.

If Range("C2") <> "" Then
    Range("A2") = "1"
    Son = Cells(Rows.Count, 3).End(3).Row
    Range("A2").AutoFill Destination:=Range("A2:A" & Son), Type:=xlFillSeries
End If

Üye numarası ile ilgili bir detay vermemişsiniz. Nasıl bir numara vermek istiyorsunuz?

 

[muhammetozgen]

uye no ve sıra no 1 den başlayacak sırano her kayıtta artacak uye no ise sorunun cevabı evetse artacak

 

[Korhan Ayhan]

Butona ait kodu aşağıdaki ile değiştirip deneyiniz.

Private Sub CommandButton1_Click()
    Dim bak As Range '****
    Dim say As Integer
    
    On Error Resume Next
    Sheets("veri").Select
    
    For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000")))
        If bak.Value = ComboBox1.Value Then
            MsgBox "Bu Üye numarasi bulundu."
            Exit Sub
        End If
        If ComboBox1.Text = "" Then
            MsgBox "Lütfen önce isim soyad girin...", , "Kayit Hatasi!!!"
            Exit Sub
        End If
    Next bak
    
    For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
            MsgBox "Bu isimde bir kaydiniz bulundu"
            Exit Sub
        End If
    Next bak
    
    say = WorksheetFunction.CountA(Range("a1:a65500"))
    TextBox1.Value = say
    
    Cells(say + 1, 1).Value = TextBox1.Value
    
    If ComboBox33334 = "Evet " Then
        Cells(say + 1, 2).Value = WorksheetFunction.Max(Range("B:B")) + 1
    End If
    
    Cells(say + 1, 3).Value = ComboBox1.Value
    Cells(say + 1, 53).Value = ComboBox3.Value
    Cells(say + 1, 4).Value = TextBox1801.Value
    Cells(say + 1, 5).Value = TextBox3.Value
    Cells(say + 1, 6).Value = TextBox4.Value
    Cells(say + 1, 7).Value = TextBox5.Value
    Cells(say + 1, 8).Value = TextBox6.Value
    Cells(say + 1, 9).Value = TextBox7.Value
    Cells(say + 1, 10).Value = TextBox8.Value
    Cells(say + 1, 11).Value = TextBox9.Value
    Cells(say + 1, 12).Value = TextBox10.Value
    Cells(say + 1, 13).Value = TextBox11.Value
    Cells(say + 1, 14).Value = TextBox12.Value
    Cells(say + 1, 15).Value = TextBox13.Value
    Cells(say + 1, 16).Value = TextBox14.Value
    Cells(say + 1, 17).Value = ComboBox33333.Value
    Cells(say + 1, 18).Value = ComboBox4.Value
    Cells(say + 1, 19).Value = TextBox21.Value
    Cells(say + 1, 20).Value = TextBox22.Value
    Cells(say + 1, 21).Value = TextBox23.Value
    Cells(say + 1, 22).Value = TextBox24.Value
    Cells(say + 1, 23).Value = TextBox25.Value
    Cells(say + 1, 24).Value = TextBox26.Value
    Cells(say + 1, 25).Value = ComboBox5.Value
    Cells(say + 1, 26).Value = TextBox27.Value
    Cells(say + 1, 27).Value = TextBox28.Value
    Cells(say + 1, 28).Value = ComboBox6.Value
    Cells(say + 1, 29).Value = TextBox29.Value
    Cells(say + 1, 30).Value = TextBox30.Value
    Cells(say + 1, 31).Value = ComboBox7.Value
    Cells(say + 1, 32).Value = TextBox31.Value
    Cells(say + 1, 33).Value = ComboBox33334.Value
    Cells(say + 1, 34).Value = ComboBox8.Value
    Cells(say + 1, 35).Value = TextBox33.Value
    Cells(say + 1, 36).Value = TextBox34.Value
    Cells(say + 1, 37).Value = ComboBox9.Value
    Cells(say + 1, 38).Value = TextBox35.Value
    Cells(say + 1, 39).Value = TextBox36.Value
    Cells(say + 1, 40).Value = TextBox1802.Value
    Cells(say + 1, 41).Value = ComboBox10.Value
    Cells(say + 1, 42).Value = TextBox37.Value
    
    If Range("C2") <> "" Then
        Range("A2") = "1"
        Son = Cells(Rows.Count, 3).End(3).Row
        Range("A2").AutoFill Destination:=Range("A2:A" & Son), Type:=xlFillSeries
    End If
    
    MsgBox "Yeni Üye kayiti Başariyla Yapilmistir.Iyi Çalismalar Dilerim", vbInformation, "Sn.  " & Application.UserName

    Range("A2:A65500").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        '************************
    Range("B2:U65500").Select
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("B2").Select '*********
    TextBox1.Value = WorksheetFunction.Count(Range("A1:A65500")) + 1
    CommandButton5_Click
    TextBox1700 = Sheets("veri").Range("Ar1").Value
    TextBox1800 = Sheets("veri").Range("As1").Value
    ComboBox2_Change
    ComboBox1.SetFocus
    Unload UserForm1
    UserForm1.Show
End Sub

 

[muhammetozgen]

cok tesekkurler eline emeğine sağlık