excel vba accesden like operatörü ile listemele yapmak

[erdemdag34]

Değerli ustalarım merhabalar.
Stok kaydı tuttuğum veri tabanımın var accesde, excel vba ile kullanıyorum.
like operatörü ile excelde c3 hücresine aranacak parça adı için bir kaç harf girdiğimde örneğin batarya adı geçen stokları listelemek için bat yazıp batarya kelimesi geçenleri listelemek gayretindeyim ama yapamadım.
Ricam siz değerli ustalarımın yardımına ihtiyacım var


Sub stok_listeleme()
Application.ScreenUpdating = False
On Error Resume Next
ara= Range("c3").Text
sorgu = "SELECT * FROM [tamir] WHERE parça_kodu '%" & ara& "%'"
Call database_open
Set DataKayitlari = DataBaglan.OpenRecordset(sorgu, dbOpenSnapshot)
Cells(8, "b").CopyFromRecordset DataKayitlari
Call database_close
Set DataKayitlari = Nothing
Set DataBaglan = Nothing
Application.ScreenUpdating = True
End Sub

[erseldemirel]

Merhaba şunu denediniz mi

Kod: Tümünü seç

ara = "*" & Range("C3").Value & "*"

[erdemdag34]

merhaba Ersel bey.
Yardımınız için teşekkür ederim efendim
Dediğiniz şekilde denedim ancak başarılı olamadım; muhtemel ben bişeyleri yapamadım
Sizden ricam efendim kodlara bi bakabilirseniz size zahmet.
Excel vba accesde çok yeni ve aşırı hevesliyim; yaşamıma yaymaya başladım iyi anlamda, boş vaktimde oturup uğraşır oldum büyük keyifle

End Sub
Sub stok_listeleme()
Application.ScreenUpdating = False
On Error Resume Next
ara = "*" & Range("C3").Value & "*"
sorgu = "SELECT * FROM [tamir] WHERE parça_kodu '%" & ara & "%'"
Call database_open
Set DataKayitlari = DataBaglan.OpenRecordset(sorgu, dbOpenSnapshot)
Cells(8, "b").CopyFromRecordset DataKayitlari
Call database_close
Set DataKayitlari = Nothing
Set DataBaglan = Nothing
Application.ScreenUpdating = True
End Sub

[erseldemirel]

Bence siz örnek dosyalarınızı yükleyin forumdan da cevap gelebilir

[erdemdag34]

Dosya yükleme yerini bulamadım Ersel bey; bağışlayın lütfen

[erseldemirel]

Access pek kullanmadım ama indirme linki olan bir url bulursanırz forumdan cevap verenlerde olur online dosya yükleme siteleri gibi

[erdemdag34]

Ersel bey ilgi ve desteğiniz için çok çok teşekkür ederim efendim, selamlar saygılar

[erdemdag34]

Ersel bey dosya eklemeyi buldum ekledim varsa elinizden gelen bi bakmanız ricam olur sayın abim, değilse de sonsuz teşekkürlerimi sunarım efendim

[Alibuyuk66]

```vba
Sub stok_listeleme()
Application.ScreenUpdating = False
On Error Resume Next

Dim ara As String
Dim sorgu As String
ara = Range("C3").Text

' Sorgu ifadesini düzgün bir şekilde oluşturun
sorgu = "SELECT * FROM [tamir] WHERE parça_kodu LIKE '%" & ara & "%'"

Call database_open
Set DataKayitlari = DataBaglan.OpenRecordset(sorgu, dbOpenSnapshot)
Cells(8, "B").CopyFromRecordset DataKayitlari
Call database_close

Set DataKayitlari = Nothing
Set DataBaglan = Nothing
Application.ScreenUpdating = True
End Sub
```

Yapmanız gereken değişiklikler:

1. `ara` ve `sorgu` değişkenlerini tanımlayın ve sorguyu LIKE operatörü ile düzgün bir şekilde oluşturun.
2. LIKE operatörü için sorgu ifadesinde `%` karakterlerini kullanmalısınız.
3. Tanımladığınız değişkenlerin türlerini belirtmeye dikkat edin. `ara` ve `sorgu` birer metin (String) olmalıdır.

Kodunuzu bu şekilde düzelttiğinizde, aranacak parça kodu ile eşleşen sonuçları doğru bir şekilde almanız gerekmelidir.

[erseldemirel]

Excelinizde test sayfası açın. c3 hücresine DESK yazınca DESKTOP PC buldu. deneyiniz

Kod: Tümünü seç

Sub test()
    Dim db As Object
    Dim rs As Object
    Dim strSQL As String
    Dim ParcaAdi As String
    Dim ArananKelime As String
    Dim SatirID As Long
    Dim HedefHucresi As Range

    dbPath = "C:\............\DB.accdb"
    
    Set HedefHucresi = ThisWorkbook.Sheets("test").Range("A4")
    ArananKelime = ThisWorkbook.Sheets("test").Range("C3").Value

    Set db = CreateObject("Access.Application")
    db.OpenCurrentDatabase dbPath


    strSQL = "SELECT [parça_adı], [ID] FROM tamir WHERE [parça_adı] LIKE '*" & ArananKelime & "*'"
    Set rs = db.CurrentDb.OpenRecordset(strSQL)

    If Not rs.EOF Then
        SatirID = rs.Fields("ID")
        rs.Close
        Set rs = Nothing

        strSQL = "SELECT * FROM tamir WHERE [ID] = " & SatirID
        Set rs = db.CurrentDb.OpenRecordset(strSQL)

        If Not rs.EOF Then
            For SutunIndex = 0 To rs.Fields.Count - 1
                HedefHucresi.Offset(0, SutunIndex).Value = rs.Fields(SutunIndex).Value
            Next SutunIndex
        Else
            MsgBox "ID yok"
        End If

        rs.Close
        Set rs = Nothing
    Else
        MsgBox "Aranan kelime yok"
    End If

    db.Quit
    Set db = Nothing
End Sub

[erdemdag34]

Ersel bey abi teşekkür ederim oldu abi, sadece şu mümkün olurmu; desk yazınca desk içerenleri listelenmesi abi ?

[erdemdag34]

Ali bey abi teşekkür ederim emeğiniz ve desteğiniz için. Abi dediğinizi birebir denedim galiba benden kaynaklı olmadı sayın abim

[erseldemirel]

Şöyle deneyin. Veri getirme çalışınca kalanı zor değil. Çıkmam lazım kolay gelsin

Kod: Tümünü seç

Sub test()
    Dim db As Object
    Dim rs As Object
    Dim strSQL As String
    Dim ParcaAdi As String
    Dim ArananKelime As String
    Dim HedefHucresi As Range

    dbPath = "C:\............\DB.accdb"
    
    Set HedefHucresi = ThisWorkbook.Sheets("test").Range("A4")
    ArananKelime = ThisWorkbook.Sheets("test").Range("C3").Value

    Set db = CreateObject("Access.Application")
    db.OpenCurrentDatabase dbPath

    strSQL = "SELECT * FROM tamir WHERE [parça_adı] LIKE '*" & ArananKelime & "*'"
    Set rs = db.CurrentDb.OpenRecordset(strSQL)

    If Not rs.EOF Then
        Do While Not rs.EOF
            For SutunIndex = 0 To rs.Fields.Count - 1
                HedefHucresi.Offset(0, SutunIndex).Value = rs.Fields(SutunIndex).Value
            Next SutunIndex
            Set HedefHucresi = HedefHucresi.Offset(1, 0)
            rs.MoveNext
        Loop
    Else
        MsgBox "Aranan kelime yok"
    End If

    rs.Close
    Set rs = Nothing

    db.Quit
    Set db = Nothing
End Sub

[erdemdag34]

Ersel bey, Ali bey: İstediğim tamda buydu ve oldu
saygıyla, sevgiyle sizleri selamlıyorum efendim, iyiki varsınız, sonsuz teşekkürler Ersel bey, Ali bey