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

Katılım
30 Nisan 2007
Mesajlar
114
Beğeniler
2
Excel Vers. ve Dili
exel2007
#21
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
 

Ekli dosyalar

Son düzenleme:

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
24,293
Beğeniler
287
Excel Vers. ve Dili
OFFICE 2013-2016 PRO TR
#22
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.

Kod:
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?
 
Katılım
30 Nisan 2007
Mesajlar
114
Beğeniler
2
Excel Vers. ve Dili
exel2007
#23
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

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
24,293
Beğeniler
287
Excel Vers. ve Dili
OFFICE 2013-2016 PRO TR
#24
Butona ait kodu aşağıdaki ile değiştirip deneyiniz.

Kod:
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
 
Katılım
30 Nisan 2007
Mesajlar
114
Beğeniler
2
Excel Vers. ve Dili
exel2007
#25
cok tesekkurler eline emeğine sağlık
 
Üst