listboxda süzülen değerlerin otomatik numaralandırılması?

[udentr2002]

Merhaba Arkadaşlar depomuzda bulunan hammaddelerin kodlanabilmesi için yaptığım küçük programda comboboxlar ve texy-tboxa girilen değerlere göre filtreleme yapıyor gönderdiğim programı incelerseniz combobox1 e hammaddenin adını yazıyoruz combobox2 ye ise özeeliğini belirtiyoruz (etken madde, uçucu madde, diğerleri gibi) bu veriyi yani combobox2 de belirttiğimiz özeeliğe göre textbox o hammaddenin kodunun başlangıcını otomatik getiriyor ve bende enson numarayı bir arttırıp en fazla 6 karakter olmak üzere yeni hammaddenin kodunu vermiş oluyorum benim istediğim ise şu;

hammaddenin adını yazıp combobox 2 de özelliğini seçtikten sonra textbox1'e kendisi otomatik olarak süzdüğü verilerin numarasını bir arttırıp textbox1 e yazacak
dikkat ederseniz combobox2 yi etken madde olarak seçersek textbox1 otomatik olarak H10 rakamını kendi yazıp imleci 3. karakterden sonra bekletiyor ve listbox1 de 3. stünda etken maddeler için daha önce verilmiş olan kodlar görünüyor bende o listbox1 i 3. stünunundaki numaralarından en sonuncusunu bir arttırıp kodlamayı yapıyorum benim istediğim ise numaralandırmayı kensdisinin yapıp textbox1 e yazması böyle bir kodu nasıl yazabilrim

size yapmış olduğum ve şu anda kullandığım programı gönderiyorum yardım edecek hocalarıma şimdiden teşekkür ederim

 

[veyselemre]

Örneğinizi inceleyin.

 

[udentr2002]

veysel üstadım

elllerinize sağlık çok güzel olmuş Allah razı olsun

 

[udentr2002]

veysel hocam

aynı mantıkla aynı kodu başka yerde de kullanmaya çalışıyorum kendime uyarlamaya çalışltım ama olmuyor hatta tamamen değişiklik yapıpta denedim ama olmuyor daha doğrusu ben beceremedim burda değişen sadece süzmeyi listboxun 4. stünunda yapıyor ve koddaki karakter sayısı 7 denemeye çalıştığım kodu gönderiyorum neden olmadı acaba tekrar yardım edebilirmisiniz hocam lütfen


Private Sub TextBox2_Change()
Dim lst1()
On Error Resume Next
ListBox2.RowSource = Empty
ListBox2.Clear
ListBox2.ColumnHeads = True
For Each isim In Sheets("AmbalajKodlar").Range("D3" & Sheets("AmbalajKodlar").Range("D65536").End(3).Row)
If UCase(LCase(isim)) Like Left(UCase(LCase(TextBox2)), 4) & "*" Then
isim.Select
liste = ListBox2.ListCount
ListBox2.AddItem
ListBox2.List(liste, 0) = isim.Offset(0, -3)
ListBox2.List(liste, 1) = isim.Offset(0, -2)
ListBox2.List(liste, 2) = isim.Offset(0, -1)
ListBox2.List(liste, 3) = isim
ListBox2.List(liste, 4) = isim.Offset(0, 1)
ListBox2.List(liste, 5) = isim.Offset(0, 2)
ReDim Preserve lst1(0 To a)
lst1(a) = isim.Text
a = a + 1

End If
Next
TextBox2 = HarfliBirfazlasi1(lst1)
End Sub

Function HarfliBirfazlasi1(lst1 As Variant)
Harf = Left(lst1(LBound(lst1)), 1)
mx = 0
For X = LBound(lst1) To UBound(lst1)
yeni = Replace(lst1(X), Harf, "")
If yeni > mx Then mx = yeni
Next X
HarfliBirfazlasi1 = Harf & Format(mx + 1, "000000")
End Function

 

[veyselemre]

Örnek dosya mesajınıza ekleyin.

 

[udentr2002]

Hocam

dosya ektedir sizi yoruyorum ama bakarsanız çok sevineceğim diğer gönderdiğiniz kodu kullanıyorum işime çok yaradı aynı mantıkla başka yerde de kullanmam lazımdı ben çözebilrim demiştim ama malesef çözemedim tembellik ettiğimi sanmayın inanın uğraştım ama yapamadım SAYGILARIMLA

 

[veyselemre]

Private Sub ComboBox3_Change()
    On Error Resume Next
    ListBox2.RowSource = Empty
    ListBox2.Clear
    For Each isim In Sheets("AmbalajKodlar").Range("B3:B" & Sheets("AmbalajKodlar").Range("B65536").End(3).Row)
        If UCase(LCase(isim)) Like UCase(LCase(ComboBox3)) & "*" Then
            isim.Select
            liste = ListBox2.ListCount
            ListBox2.AddItem
            ListBox2.List(liste, 0) = isim.Offset(0, -1)
            ListBox2.List(liste, 1) = isim
            ListBox2.List(liste, 2) = isim.Offset(0, 1)
            ListBox2.List(liste, 3) = isim.Offset(0, 2)
            ListBox2.List(liste, 4) = isim.Offset(0, 3)
            ListBox2.List(liste, 5) = isim.Offset(0, 4)
        End If
    Next
    TextBox2.SelStart = 3
    TextBox2.SetFocus
    If ComboBox5.Text = "ORİJİNAL" And ComboBox3.Text = "KUTU" Then
        TextBox2.Text = "A3S" & ""
    ElseIf ComboBox5.Text = "SATIŞ" And ComboBox3.Text = "KUTU" Then
        TextBox2.Text = "A3D" & ""
    ElseIf ComboBox5.Text = "ORİJİNAL" And ComboBox3.Text = "TÜP" Then
        TextBox2.Text = "A4S" & ""
    ElseIf ComboBox5.Text = "SATIŞ" And ComboBox3.Text = "TÜP" Then
        TextBox2.Text = "A4D" & ""
    ElseIf ComboBox5.Text = "ORİJİNAL" And ComboBox3.Text = "KAPAK" Then
        TextBox2.Text = "A6S" & ""
    ElseIf ComboBox5.Text = "SATIŞ" And ComboBox3.Text = "KAPAK" Then
        TextBox2.Text = "A6S" & ""
    End If
End Sub
Private Sub ComboBox5_Change()
    If ComboBox5.Text = "ORİJİNAL" And ComboBox3.Text = "KUTU" Then
        TextBox2.Text = "A3S" & ""
    ElseIf ComboBox5.Text = "SATIŞ" And ComboBox3.Text = "KUTU" Then
        TextBox2.Text = "A3D" & ""
    ElseIf ComboBox5.Text = "ORİJİNAL" And ComboBox3.Text = "TÜP" Then
        TextBox2.Text = "A4S" & ""
    ElseIf ComboBox5.Text = "SATIŞ" And ComboBox3.Text = "TÜP" Then
        TextBox2.Text = "A4D" & ""
    ElseIf ComboBox5.Text = "ORİJİNAL" And ComboBox3.Text = "KAPAK" Then
        TextBox2.Text = "A6S" & ""
    ElseIf ComboBox5.Text = "DR. SATIŞ" And ComboBox3.Text = "KAPAK" Then
        TextBox2.Text = "A6S" & ""
    End If
End Sub
Private Sub TextBox2_Change()
    ReDim lst1(0)
    On Error Resume Next
    ListBox2.RowSource = Empty
    ListBox2.Clear
    ListBox2.ColumnHeads = True
    For Each isim In Sheets("AmbalajKodlar").Range("D3:D" & Sheets("AmbalajKodlar").Range("D65536").End(3).Row)
        If UCase(LCase(isim)) Like Left(UCase(LCase(TextBox2)), 3) & "*" Then
            isim.Select
            isim.Select
            liste = ListBox2.ListCount
            ListBox2.AddItem
            ListBox2.List(liste, 0) = isim.Offset(0, -3)
            ListBox2.List(liste, 1) = isim.Offset(0, -2)
            ListBox2.List(liste, 2) = isim.Offset(0, -1)
            ListBox2.List(liste, 3) = isim
            ListBox2.List(liste, 4) = isim.Offset(0, 1)
            ListBox2.List(liste, 5) = isim.Offset(0, 2)
            If a > 0 Then ReDim Preserve lst1(0 To a)
            lst1(a) = isim.Text
            a = a + 1
        End If
    Next
    TextBox2 = HarfliBirfazlasi1(lst1)
End Sub
Function HarfliBirfazlasi1(lst1 As Variant)
    harf = Left(lst1(LBound(lst1)), 3)
    mx = 0
    yeni = 0
    For X = LBound(lst1) To UBound(lst1)
        yeni = Replace(lst1(X), harf, "")
        If yeni > mx Then mx = yeni
    Next X
    HarfliBirfazlasi1 = harf & Format(mx + 1, "0000")
End Function
Private Sub TextBox2_Enter()
    If Len(TextBox2.Text) = 3 Then TextBox2.Text = TextBox2.Text & "0001"
End Sub
Private Sub UserForm_Initialize()
    ListBox2.RowSource = "AmbalajKodlar!a3:F" & Sheets("AmbalajKodlar").Range("a65536").End(3).Row
    ListBox2.ColumnCount = 6
    ListBox2.ColumnHeads = True
    ListBox2.ColumnWidths = "75;100;180;80;170;25"
    With ComboBox3
        .AddItem "KUTU"
        .AddItem "TÜP"
        .AddItem "KAPAK"
    End With
    With ComboBox5
        .AddItem "ORİJİNAL"
        .AddItem "SATIŞ"
    End With
    ComboBox6.RowSource = "AmbalajKodlar!c3:c" & Sheets("AmbalajKodlar").Range("c65536").End(3).Row
End Sub

 

[udentr2002]

veysel hocam

Elinize sağlık gerçekten güzel olmuş Bu forumdaki tüm arkadaşlar gerçekten çok harika insanlar sadece paylaşmak adına hiç bi mecburiyetiniz vede çıkarınız olmadan bile problemlerimizle uğraşıp işlerimizi kolaylaştırıyorsunuz vede bigilerinizi bizlerle paylaşıyorsunuz sadece sizlere ALLAH RAZI OLSUN demek istiyorum hepinize SAYGILARIMLA