makro ile bul komutunda exceldeki bilgiler textbox da gelmiyor.

[puslukurt]

Merhaba arkadaşlar...
Excelde 9 sutundan oluşan bir tablom var bu tablomu userform üzerine 1 adet açılır combobox, 1 adet commandbuton ve 8 adet de textbox yaparak aradığımı daha kolay bulayım dedim ve aşağıdaki kodu yazdım. lakin combobox tan isim seçiyorum ve command butona basıyorum fakat bilgiler textbox lara gelmiyor yardımlarınız için teşekkür ederim.








Private Sub CommandButton1_Click()
Sheets("Sayfa1").Select
Range("A1").Select '
If ComboBox1.Value = "" Then
MsgBox "Lütfen bir isim giriniz.", , "İSİM GEREKLİ"
End If
On Error Resume Next
Cells.Find(What:=ComboBox1.Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
If ActiveCell.Value <> ComboBox1.Text Then
Dim bak As Range
For Each bak In Range("A2:A" & WorksheetFunction.CountA(Range("A1:A65000")) + 1) 'değiştir
If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox1.Value, vbUpperCase) Then
bak.Select
TextBox1.Value = ActiveCell.Offset(0, 1).Value
TextBox2.Value = ActiveCell.Offset(0, 2).Value
TextBox3.Value = ActiveCell.Offset(0, 3).Value
TextBox4.Value = ActiveCell.Offset(0, 4).Value
TextBox5.Value = ActiveCell.Offset(0, 5).Value
TextBox6.Value = ActiveCell.Offset(0, 6).Value
TextBox7.Value = ActiveCell.Offset(0, 7).Value
TextBox8.Value = ActiveCell.Offset(0, 8).Value

Exit Sub
End If
Next bak

MsgBox "Büyük Harf / Küçük Harfe dikkat ederseniz bu mesajı almazsınız.", , "İŞLEMİNİZ YAPILACAK."
End If


End Sub

 

[Muzaffer Ali]

Merhaba.

CombBox'un click olayına yazılırsa butona gerek kalmadan sadece seçim yapıldığında kodlar çalışabilir.

Private Sub ComboBox1_Change()
    Dim Bul As Range
    Dim Bak As Range
    If ComboBox1.Value = "" Then
        MsgBox "Lütfen bir isim giriniz.", , "İSİM GEREKLİ"
        Exit Sub
    End If
    Set Bul = Range("A:A").Find(What:=ComboBox1.Value, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not Bul Is Nothing Then
        TextBox1.Value = Cells(Bul.Row, "B")
        TextBox2.Value = Cells(Bul.Row, "C")
        TextBox3.Value = Cells(Bul.Row, "D")
        TextBox4.Value = Cells(Bul.Row, "E")
        TextBox5.Value = Cells(Bul.Row, "F")
        TextBox6.Value = Cells(Bul.Row, "G")
        TextBox7.Value = Cells(Bul.Row, "H")
        TextBox8.Value = Cells(Bul.Row, "I")
    End If
End Sub

Private Sub CommandButton1_Click()
    Dim SonSatir As Long
    If ComboBox1.Text = "" Then
        MsgBox "Lütfen önce bir isim yazınız.", vbExclamation
        Exit Sub
    ElseIf Not Range("A:A").Find(What:=ComboBox1.Value, LookIn:=xlFormulas, LookAt:=xlPart) Is Nothing Then
        If MsgBox("Bu isimde bir kayıt var, yinede kaydetmek istiyor musunuz?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
    End If
    SonSatir = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Cells(SonSatir, "A") = ComboBox1.Value
    Cells(SonSatir, "B") = TextBox1.Value
    Cells(SonSatir, "C") = TextBox2.Value
    Cells(SonSatir, "D") = TextBox3.Value
    Cells(SonSatir, "E") = TextBox4.Value
    Cells(SonSatir, "F") = TextBox5.Value
    Cells(SonSatir, "G") = TextBox6.Value
    Cells(SonSatir, "H") = TextBox7.Value
    Cells(SonSatir, "I") = TextBox8.Value
    ComboBox1.RowSource = "A2:A" & Cells(Rows.Count, "A").End(xlUp).Row
End Sub

 

[puslukurt]

Teşekkür ederim muzaffer bey çalışıyor click olayına yazdığımda şöyle bir sorun çıktı combox kendim yazdığımda getirmiyor o yüzden change olayına yazmak zorunda kaldım bir son bir ricam var sizden bu tabloya yeni kayıt yapmak için commanbutana nasıl bir kod yazmalıyız

 

[Muzaffer Ali]

Kodu isteğinize göre düzenledim.

 

[puslukurt]

çok teşekkür ederim muzaffer bey elinize emeğinize sağlık