değiştir makrosu nasıl olmalı?

[enes2000eren]

slm.arkadaşlar sistemdeki dosyaları inceledim ve bir takım kodları denedim ama bir türlü istediğim gibi olmuyor.mesela bu dosyadaki değiş tir makrusu comboboxa veriler seçilince gelen verilerden sadece (b) sütunun verileri değiştiriyor.diğerlerini bir türlü değiştirmiyor.koddaki revizyon için yardıma ihtiyacım var.tşk.

 

[Korhan Ayhan]

Selamlar,

Formunuzun UserForm_Initialize() ve FİRMA.Change() bölümündeki kodu aşağıdaki kodla değiştirip denermisiniz.

Aşağıdaki kod benzer firma adlarında ilk bulduğu satırdaki veriyi değiştirir. Firma adlarınızda mükerrer olanlar varsa kod sağlıklı çalışmayacaktır.

Private Sub FİRMA_Change()
    Dim BUL As Range
    Set BUL = Range("B:B").Find(FİRMA.Text, , , xlWhole)
    If Not BUL Is Nothing Then
    AKTİFSATIR = BUL.Row
    DEĞİŞTİR.Visible = True
    TextBox1.Text = Sheets("KAYIT").Range("B" & AKTİFSATIR).Value
    TextBox2.Text = Sheets("KAYIT").Range("C" & AKTİFSATIR).Value
    TextBox3.Text = Sheets("KAYIT").Range("D" & AKTİFSATIR).Value
    TextBox4.Text = Sheets("KAYIT").Range("E" & AKTİFSATIR).Value
    TextBox5.Text = Sheets("KAYIT").Range("F" & AKTİFSATIR).Value
    TextBox6.Text = Sheets("KAYIT").Range("G" & AKTİFSATIR).Value
    TextBox7.Text = Sheets("KAYIT").Range("H" & AKTİFSATIR).Value
    TextBox8.Text = Sheets("KAYIT").Range("I" & AKTİFSATIR).Value
    TextBox9.Text = Sheets("KAYIT").Range("J" & AKTİFSATIR).Value
    TextBox10.Text = Sheets("KAYIT").Range("K" & AKTİFSATIR).Value
    'TextBox11.Text = Sheets("KAYIT").Range("L" & AKTİFSATIR).Value
    TextBox12.Text = Sheets("KAYIT").Range("M" & AKTİFSATIR).Value
    TextBox13.Text = Sheets("KAYIT").Range("N" & AKTİFSATIR).Value
    TextBox14.Text = Sheets("KAYIT").Range("O" & AKTİFSATIR).Value
    TextBox15.Text = Sheets("KAYIT").Range("P" & AKTİFSATIR).Value
    TextBox16.Text = Sheets("KAYIT").Range("Q" & AKTİFSATIR).Value
    'TextBox17.Text = Sheets("KAYIT").Range("R" & AKTİFSATIR).Value
    'TextBox18.Text = Sheets("KAYIT").Range("S" & AKTİFSATIR).Value
    TextBox19.Text = Sheets("KAYIT").Range("T" & AKTİFSATIR).Value
    'TextBox20.Text = Sheets("KAYIT").Range("U" & AKTİFSATIR).Value
    TextBox21.Text = Sheets("KAYIT").Range("A" & AKTİFSATIR).Value
    TextBox11 = Format(TextBox11, "#,###.00")
    TextBox12 = Format(TextBox12, "#,###.00")
    TextBox17 = Format(TextBox17, "#,###.00")
    TextBox18 = Format(TextBox18, "#,###.00")
    TextBox19 = Format(TextBox19, "#,###.00")
    TextBox20 = Format(TextBox20, "#,###.00")
    End If
End Sub
 
Private Sub UserForm_Initialize()
    FİRMA.Clear
    For X = 2 To Range("A65536").End(3).Row
    If WorksheetFunction.CountIf(Range("B2:B" & X), Cells(X, "B")) = 1 Then FİRMA.AddItem Cells(X, "B")
    Next
 
    İPTAL.Visible = False
    DEĞİŞTİR.Visible = True
    KAYIT.Visible = False
    YENİKAYIT.Visible = True
 
 
    'TextBox11.Enabled = False
    'TextBox17.Enabled = False
    'TextBox18.Enabled = False
    'TextBox20.Enabled = False
 
    TextBox11.ForeColor = vbRed
    TextBox17.ForeColor = vbRed
    TextBox18.ForeColor = vbRed
    TextBox20.ForeColor = vbRed
End Sub

 

[enes2000eren]

yardımlarınız tşk.korhan bey ya mükerrer kayıt varsa ki olacak o zaman ne yapmak lazım.çünkü ben firmaya yaptığım her iş için aybı adı kullanacağım.

 

[enes2000eren]

Bir düzenleme yaptım.ama bu sefer mükerrer kayıtı engellemem lazım.b sütununa göre.yardımlarınızı bekliyorum