Sorgulama, Arama sırasında kasma ve yavaşlama sorunu

udentr2002 · 27 Ocak 2022

Arkadaşlar merhaba;
Örnek dosyada, sayfa üzerine grup form düğmesine tıkladığınızda açılan genel bilgiler düğmesi ile form açılacak ; Orda combobox1 e yazılan veriye göre commandbutton1 düğmesinin altına kodu yazdım

Bir butona click olayının altına kodlar yazdım. Çalışıyor ancak kodu yazarken comboxa yazılan veri sonucu ordaki veriyi sayfada arayıp select yapıp o bulduğu hücreyi aktif ediyor, buda kodun yavaşlamasına sebep oluyor. sayfada veri çok olunca yavaşlama oluyor.
Comboxa yazdığım veriyi sayfada arayıp bulduğu verileri listboxda gösteriyor ve form üzerinde yer alan textboxlara yazıyor. Ayrıca listbox üzerinde tıklayınca o verileride textboxlaera atıyor. Benim yazdığım kod aşağıda ama sanırım çok amatörce ve sanırım her veri sorgulamasında listboxu yeniden oluşturuyor gibi. Benim kodun yerine daha hızlı ve arama yapıp bulduğu veriyi select yapıp o hücreyi aktif etmeden nasıl düzeltebilirim? Koda bir göz atabilir misiniz?
Şimdidien ilginiz için çok teşekkür ederim.
Yardım ederseniz çok sevinirim.
SAYGILARIMLA

ÖmerFaruk · 27 Ocak 2022

Şunu sormak istiyorum.

Listbox koyduğuna göre aranan ismi içeren birden fazla satır olabilir. Doğru mudur?
Birinci soru doğruysa ve diyelim 3 tane isim varsa, TextBoxlara 1.yi mi sonucuyu mu yazmak istiyorsunuz?

udentr2002 · 27 Ocak 2022

ÖmerFaruk' Alıntı:
Şunu sormak istiyorum.

Listbox koyduğuna göre aranan ismi içeren birden fazla satır olabilir. Doğru mudur?
Birinci soru doğruysa ve diyelim 3 tane isim varsa, TextBoxlara 1.yi mi sonucuyu mu yazmak istiyorsunuz?

Hocam merhaba;
Evet aranan isim içeren birden fazla isim oluyor. Ancak butona tıklayınca listboxa süzdükten sonra listboxda ilgili satıra tıklayınca textboxlara veriyi atabilir.
Yani comboboxdaki veriyi butona tıklayıp listboxa süzdükten sonra listboxa tıkladıktan sonra ilgili verileri textboxa aktarması daha mantıklı olur.

Şimdiden teşekkür ederim.

SAYGILARIMLA

ÖmerFaruk · 27 Ocak 2022

Aşağıdkai kodları kullanabilirsin.

C++:

Private Sub CommandButton1_Click()
Dim Veri, Listem()
    ListBox1.RowSource = Empty
    ListBox1.Clear
    
    If ComboBox1 = "" Then
        MsgBox ("Aramak İstediğiniz Ürünün ADINI yazmadınız"), vbCritical, ("DİKKAT!!!")
        GoTo Son
    End If
    ComboBox1.Value = UCase(Replace(Replace((ComboBox1.Value), "ı", "I"), "i", "İ"))
    ListBox1.ColumnWidths = "50;200;100;100;120;120;60;60;40;40;40;40;40;40;40"
    Veri = Sheets("Genel").Range("B3:P" & Sheets("Genel").Range("c65536").End(3).Row).Value
    say = 0
    For i = 1 To UBound(Veri)
        Ara = UCase(LCase(Veri(i, 2)))
        Aranan = UCase(LCase(ComboBox1)) & "*"
        If Ara Like Aranan Then
            say = say + 1
            ReDim Preserve Listem(1 To 15, 1 To say)
            For k = 1 To UBound(Veri, 2)
                Listem(k, say) = Veri(i, k)
            Next k
            Listem(8, say) = Format(Listem(8, say), "dd.mm.yyyy")
        End If
    Next i
Son:
    If say > 0 Then ListBox1.List = Application.Transpose(Listem): ListBox1.ListIndex = 0
    Call Me.TextBoxDoldur
End Sub
Sub TextBoxDoldur()
    If ListBox1.ListIndex > -1 Then
        For i = 1 To 15
            Controls("TextBox" & i) = ListBox1.List(ListBox1.ListIndex, i - 1)
            Controls("textbox" & i).BackColor = vbBlue
            Controls("textbox" & i).ForeColor = vbWhite
        Next i
    Else
        For i = 1 To 15
            Controls("textbox" & i) = ""
            Controls("textbox" & i).BackColor = vbWhite
            Controls("textbox" & i).ForeColor = vbBlue
        Next i
    End If
End Sub
Private Sub ListBox1_Click()
    Call Me.TextBoxDoldur
End Sub

udentr2002 · 27 Ocak 2022

ÖmerFaruk' Alıntı:

Aşağıdkai kodları kullanabilirsin.

C++:

Private Sub CommandButton1_Click()
Dim Veri, Listem()
    ListBox1.RowSource = Empty
    ListBox1.Clear
   
    If ComboBox1 = "" Then
        MsgBox ("Aramak İstediğiniz Ürünün ADINI yazmadınız"), vbCritical, ("DİKKAT!!!")
        GoTo Son
    End If
    ComboBox1.Value = UCase(Replace(Replace((ComboBox1.Value), "ı", "I"), "i", "İ"))
    ListBox1.ColumnWidths = "50;200;100;100;120;120;60;60;40;40;40;40;40;40;40"
    Veri = Sheets("Genel").Range("B3:P" & Sheets("Genel").Range("c65536").End(3).Row).Value
    say = 0
    For i = 1 To UBound(Veri)
        Ara = UCase(LCase(Veri(i, 2)))
        Aranan = UCase(LCase(ComboBox1)) & "*"
        If Ara Like Aranan Then
            say = say + 1
            ReDim Preserve Listem(1 To 15, 1 To say)
            For k = 1 To UBound(Veri, 2)
                Listem(k, say) = Veri(i, k)
            Next k
            Listem(8, say) = Format(Listem(8, say), "dd.mm.yyyy")
        End If
    Next i
Son:
    If say > 0 Then ListBox1.List = Application.Transpose(Listem): ListBox1.ListIndex = 0
    Call Me.TextBoxDoldur
End Sub
Sub TextBoxDoldur()
    If ListBox1.ListIndex > -1 Then
        For i = 1 To 15
            Controls("TextBox" & i) = ListBox1.List(ListBox1.ListIndex, i - 1)
            Controls("textbox" & i).BackColor = vbBlue
            Controls("textbox" & i).ForeColor = vbWhite
        Next i
    Else
        For i = 1 To 15
            Controls("textbox" & i) = ""
            Controls("textbox" & i).BackColor = vbWhite
            Controls("textbox" & i).ForeColor = vbBlue
        Next i
    End If
End Sub
Private Sub ListBox1_Click()
    Call Me.TextBoxDoldur
End Sub

Hocam Eline emeğine sağlık.
Ancak kodu çalıştırdığımda hata veriyor.;
call.metextboxdoldur kodunu sarı işaretli olarak gösteriyor
SAYGILARIMLA

ÖmerFaruk · 28 Ocak 2022

TextBoxDoldur prosedüründe bulunan aşağıdaki kod satırına imleci getirin ve F9 tuşuna basın.
Satırın başına kahverengi bir yuvarlak koyacak ve satırı da kahverengi yapacaktır

C++:

If ListBox1.ListIndex > -1 Then

Sonrasında normal şekilde userforma girin ve işlemlerinizi yapmaya başlayın.
Kod o satıra gelince duracak ve devamında siz manuel olarak F8 ile adımalayabileceksiniz.
Adımlama esnasında hangi satırda hata oluşacak ve hata oluştuğunda i değişkeni hangi değerde ona bakarmısınız?

udentr2002 · 28 Ocak 2022

ÖmerFaruk' Alıntı:
TextBoxDoldur prosedüründe bulunan aşağıdaki kod satırına imleci getirin ve F9 tuşuna basın.
Satırın başına kahverengi bir yuvarlak koyacak ve satırı da kahverengi yapacaktır

C++:

If ListBox1.ListIndex > -1 Then

Sonrasında normal şekilde userforma girin ve işlemlerinizi yapmaya başlayın.
Kod o satıra gelince duracak ve devamında siz manuel olarak F8 ile adımalayabileceksiniz.
Adımlama esnasında hangi satırda hata oluşacak ve hata oluştuğunda i değişkeni hangi değerde ona bakarmısınız?

Ömer hocam;
Aşağıdaki hata uyarısını verdi;

Compile eror
Ambiguous name detected
Listbox1.Click

ÖmerFaruk · 28 Ocak 2022

Listbox1_Click eski prosedürü silmemişsiniz.
Şöyle yapın. GENEL userformunuz altındak tüm kodları silin.
Aşağıdaki kodları komple seçip oraya yapıştırın. Ben gönderdiğiniz dosyada hata almadan sonuçları görüyorum.

C++:

Private Sub CommandButton1_Click()
Dim Veri, Listem()
    ListBox1.RowSource = Empty
    ListBox1.Clear
   
    If ComboBox1 = "" Then
        MsgBox ("Aramak İstediğiniz Ürünün ADINI yazmadınız"), vbCritical, ("DİKKAT!!!")
        GoTo Son
    End If
    ComboBox1.Value = UCase(Replace(Replace((ComboBox1.Value), "ı", "I"), "i", "İ"))
    ListBox1.ColumnWidths = "50;200;100;100;120;120;60;60;40;40;40;40;40;40;40"
    Veri = Sheets("Genel").Range("B3:P" & Sheets("Genel").Range("c65536").End(3).Row).Value
    say = 0
    For i = 1 To UBound(Veri)
        Ara = UCase(LCase(Veri(i, 2)))
        Aranan = UCase(LCase(ComboBox1)) & "*"
        If Ara Like Aranan Then
            say = say + 1
            ReDim Preserve Listem(1 To 15, 1 To say)
            For k = 1 To UBound(Veri, 2)
                Listem(k, say) = Veri(i, k)
            Next k
            Listem(8, say) = Format(Listem(8, say), "dd.mm.yyyy")
        End If
    Next i
Son:
    If say > 0 Then ListBox1.List = Application.Transpose(Listem): ListBox1.ListIndex = 0
    Call Me.TextBoxDoldur
End Sub
Sub TextBoxDoldur()
    If ListBox1.ListIndex > -1 Then
        For i = 1 To 15
            Controls("TextBox" & i) = ListBox1.List(ListBox1.ListIndex, i - 1)
            Controls("textbox" & i).BackColor = vbBlue
            Controls("textbox" & i).ForeColor = vbWhite
        Next i
    Else
        For i = 1 To 15
            Controls("textbox" & i) = ""
            Controls("textbox" & i).BackColor = vbWhite
            Controls("textbox" & i).ForeColor = vbBlue
        Next i
    End If
End Sub
Private Sub ListBox1_Click()
    Call Me.TextBoxDoldur
End Sub
Private Sub UserForm_Initialize()
    ListBox1.ColumnCount = 15
    ListBox1.RowSource = "Genel!b3:x" & Sheets("Genel").Range("B65536").End(3).Row
    ListBox1.ColumnWidths = "50;200;100;100;120;120;60;60;40;40;40;40;40;40;40"
End Sub

udentr2002 · 28 Ocak 2022

ÖmerFaruk' Alıntı:

Listbox1_Click eski prosedürü silmemişsiniz.
Şöyle yapın. GENEL userformunuz altındak tüm kodları silin.
Aşağıdaki kodları komple seçip oraya yapıştırın. Ben gönderdiğiniz dosyada hata almadan sonuçları görüyorum.

C++:

Private Sub CommandButton1_Click()
Dim Veri, Listem()
    ListBox1.RowSource = Empty
    ListBox1.Clear
  
    If ComboBox1 = "" Then
        MsgBox ("Aramak İstediğiniz Ürünün ADINI yazmadınız"), vbCritical, ("DİKKAT!!!")
        GoTo Son
    End If
    ComboBox1.Value = UCase(Replace(Replace((ComboBox1.Value), "ı", "I"), "i", "İ"))
    ListBox1.ColumnWidths = "50;200;100;100;120;120;60;60;40;40;40;40;40;40;40"
    Veri = Sheets("Genel").Range("B3:P" & Sheets("Genel").Range("c65536").End(3).Row).Value
    say = 0
    For i = 1 To UBound(Veri)
        Ara = UCase(LCase(Veri(i, 2)))
        Aranan = UCase(LCase(ComboBox1)) & "*"
        If Ara Like Aranan Then
            say = say + 1
            ReDim Preserve Listem(1 To 15, 1 To say)
            For k = 1 To UBound(Veri, 2)
                Listem(k, say) = Veri(i, k)
            Next k
            Listem(8, say) = Format(Listem(8, say), "dd.mm.yyyy")
        End If
    Next i
Son:
    If say > 0 Then ListBox1.List = Application.Transpose(Listem): ListBox1.ListIndex = 0
    Call Me.TextBoxDoldur
End Sub
Sub TextBoxDoldur()
    If ListBox1.ListIndex > -1 Then
        For i = 1 To 15
            Controls("TextBox" & i) = ListBox1.List(ListBox1.ListIndex, i - 1)
            Controls("textbox" & i).BackColor = vbBlue
            Controls("textbox" & i).ForeColor = vbWhite
        Next i
    Else
        For i = 1 To 15
            Controls("textbox" & i) = ""
            Controls("textbox" & i).BackColor = vbWhite
            Controls("textbox" & i).ForeColor = vbBlue
        Next i
    End If
End Sub
Private Sub ListBox1_Click()
    Call Me.TextBoxDoldur
End Sub
Private Sub UserForm_Initialize()
    ListBox1.ColumnCount = 15
    ListBox1.RowSource = "Genel!b3:x" & Sheets("Genel").Range("B65536").End(3).Row
    ListBox1.ColumnWidths = "50;200;100;100;120;120;60;60;40;40;40;40;40;40;40"
End Sub

Hocam yukarıda bahsettiğiniz şekilde yaptım; Kodu çalıştırdığımda bu defa aşağıdaki koda gelip
Call Me.TextboxDoldur satırını sarı olarak işaretledi hata verdi.

Private Sub ListBox1_Click()
Call Me.TextBoxDoldur
End Sub

ÖmerFaruk · 28 Ocak 2022

Command button kodlarının en altında bulunan şu satırı silin

C++:

If say > 0 Then ListBox1.List = Application.Transpose(Listem): ListBox1.ListIndex = 0

Yerine aşağıdakikeri kopyalayın

C++:

    Select Case say
    Case 0
    Case 1
    Me.ListBox1.Column = Listem: ListBox1.ListIndex = 0
    Case Else
    Me.ListBox1.List = Application.Transpose(Listem): ListBox1.ListIndex = 0
    End Select

udentr2002 · 28 Ocak 2022

ÖmerFaruk' Alıntı:
Command button kodlarının en altında bulunan şu satırı silin

C++:

If say > 0 Then ListBox1.List = Application.Transpose(Listem): ListBox1.ListIndex = 0

Yerine aşağıdakikeri kopyalayın

C++:

Select Case say Case 0 Case 1 Me.ListBox1.Column = Listem: ListBox1.ListIndex = 0 Case Else Me.ListBox1.List = Application.Transpose(Listem): ListBox1.ListIndex = 0 End Select

Ömer hocam eline emeğine sağlık hakkını helal et kodlar çalışıyor çok sağolasın.
Saygılarımla

ÖmerFaruk · 28 Ocak 2022

Eyvallah. Hakkımız varsa Helal olsun.

Sorgulama, Arama sırasında kasma ve yavaşlama sorunu

udentr2002

Ekli dosyalar

ÖmerFaruk

Destek Ekibi

udentr2002

ÖmerFaruk

Destek Ekibi

udentr2002

ÖmerFaruk

Destek Ekibi

udentr2002

ÖmerFaruk

Destek Ekibi

udentr2002

ÖmerFaruk

Destek Ekibi

udentr2002

ÖmerFaruk

Destek Ekibi