Herkese kolay gelsin. Textbox ile listbox ta arama yaptırıyorum.Arama sonucu listboxtan seçilen satırdaki ürün bilgilerini textboxlara alıyorum. Bu bilgileri güncellemek istiyorum.
Arama kodları
Private Sub TextBox6_Change()
'TEXTBOX BÜYÜK HARF
TextBox6 = Replace(TextBox6, "i", "İ")
TextBox6 = Replace(TextBox6, "ı", "I")
TextBox6 = StrConv(TextBox6, vbUpperCase)
'TEXTBOX A YAZILAN DEĞERE GÖRE ARAMA
Dim k As Range, adrs As String, j As Byte, a As Long, myarr()
ReDim myarr(1 To 7, 1 To 1)
With Worksheets("perakende")
Me.ListBox1.RowSource = vbNullString
If .FilterMode Then .ShowAllData
Set k = .Range("c1:c65536").Find(TextBox6.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 7, 1 To a)
For j = 1 To 7
myarr(j, a) = .Cells(k.Row, j).Value
Next j
Set k = .Range("c1:c65536").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adrs
ListBox1.Column = myarr
End If
End With
End Sub
Textboxlara aşağıdaki kodlarla veri alıyorum
Private Sub ListBox1_Click()
'ListBox'dan seçilen aktif hücre oluyor
Dim i As Integer
For i = 0 To ListBox1.ListCount + 1
If ListBox1.Selected(i) = True Then
Sheets("perakende").Select
Sheets("perakende").Range("A" & ListBox1.ListIndex + 2).Select
End If
Next
TextBox7.Value = ListBox1.Column(1)
TextBox8.Value = ListBox1.Column(2)
TextBox9.Value = ListBox1.Column(3)
End Sub
Güncelleme yapacak kodlar.Burada yardıma ihtiyacım var. Güncelleme yapmıyor farklı satıra ekleme yapıyor. Private Sub CommandButton2_Click()
Sheets("perakende").Select
a = MsgBox(ListBox1.Value & " " & " " & " İSİMLİ ÜRÜN BİLGİLERİNDE DEĞİŞİKLİK YAPMAK İSTEDİĞİNİZDEN EMİN MİSİNİZ?", vbYesNo, "UYARI PENCERESİ")
If a = vbNo Then
Exit Sub
Else
With Sheets("perakende").Select
'Cells(ListBox1.ListIndex + 2, 2) = TextBox7.Value
'Cells(ListBox1.ListIndex + 2, 3) = TextBox8.Value
'Cells(ListBox1.ListIndex + 2, 4) = TextBox9.Value
ActiveCell.Offset(0, 2) = TextBox7.Value
ActiveCell.Offset(0, 3) = TextBox8.Value
ActiveCell.Offset(0, 4) = CDbl(TextBox9.Value)
End With
MsgBox (TextBox8.Value & " İSİMLİ ÜRÜNÜN BİLGİLERİ GÜNCELLENMİŞTİR"), vbDefaultButton1, "UYARI PENCERESİ"
End If
End Sub
Arama kodları
Private Sub TextBox6_Change()
'TEXTBOX BÜYÜK HARF
TextBox6 = Replace(TextBox6, "i", "İ")
TextBox6 = Replace(TextBox6, "ı", "I")
TextBox6 = StrConv(TextBox6, vbUpperCase)
'TEXTBOX A YAZILAN DEĞERE GÖRE ARAMA
Dim k As Range, adrs As String, j As Byte, a As Long, myarr()
ReDim myarr(1 To 7, 1 To 1)
With Worksheets("perakende")
Me.ListBox1.RowSource = vbNullString
If .FilterMode Then .ShowAllData
Set k = .Range("c1:c65536").Find(TextBox6.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 7, 1 To a)
For j = 1 To 7
myarr(j, a) = .Cells(k.Row, j).Value
Next j
Set k = .Range("c1:c65536").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adrs
ListBox1.Column = myarr
End If
End With
End Sub
Textboxlara aşağıdaki kodlarla veri alıyorum
Private Sub ListBox1_Click()
'ListBox'dan seçilen aktif hücre oluyor
Dim i As Integer
For i = 0 To ListBox1.ListCount + 1
If ListBox1.Selected(i) = True Then
Sheets("perakende").Select
Sheets("perakende").Range("A" & ListBox1.ListIndex + 2).Select
End If
Next
TextBox7.Value = ListBox1.Column(1)
TextBox8.Value = ListBox1.Column(2)
TextBox9.Value = ListBox1.Column(3)
End Sub
Güncelleme yapacak kodlar.Burada yardıma ihtiyacım var. Güncelleme yapmıyor farklı satıra ekleme yapıyor. Private Sub CommandButton2_Click()
Sheets("perakende").Select
a = MsgBox(ListBox1.Value & " " & " " & " İSİMLİ ÜRÜN BİLGİLERİNDE DEĞİŞİKLİK YAPMAK İSTEDİĞİNİZDEN EMİN MİSİNİZ?", vbYesNo, "UYARI PENCERESİ")
If a = vbNo Then
Exit Sub
Else
With Sheets("perakende").Select
'Cells(ListBox1.ListIndex + 2, 2) = TextBox7.Value
'Cells(ListBox1.ListIndex + 2, 3) = TextBox8.Value
'Cells(ListBox1.ListIndex + 2, 4) = TextBox9.Value
ActiveCell.Offset(0, 2) = TextBox7.Value
ActiveCell.Offset(0, 3) = TextBox8.Value
ActiveCell.Offset(0, 4) = CDbl(TextBox9.Value)
End With
MsgBox (TextBox8.Value & " İSİMLİ ÜRÜNÜN BİLGİLERİ GÜNCELLENMİŞTİR"), vbDefaultButton1, "UYARI PENCERESİ"
End If
End Sub