Makro Tek tırnak hatası

Katılım
4 Eylül 2020
Mesajlar
394
Excel Vers. ve Dili
Excel 2016
Altın Üyelik Bitiş Tarihi
22-11-2022
Merhaba aşağıdaki kod diğer sayfadan veri çekerken hücre içeriğinde ' tırnak varsa 234581
Böyle hata vermektedir. Yardımcı olursanız sevinirim

Kod:
Option Explicit

Sub Analiz()
    Dim S1 As Worksheet, S2 As Worksheet, Baglanti As Object
    Dim Kayit_Seti As Object, Sorgu As String, Veri_Seti As Object
    Dim Urun_Grubu As Variant, Satir As Long, Baslik As Variant
    Dim Sutun As Byte, Say As Long, Zaman As Double
    
  
    Zaman = Timer
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sube_Hareketleri")
    Set S2 = Sheets("Sayfa1")
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.RecordSet")
    Set Veri_Seti = CreateObject("AdoDb.RecordSet")
    
    S2.Cells.Delete
    Satir = 3
    Sutun = 1

    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=Yes"""

    Sorgu = "Select [MALINCINSI] From [" & S1.Name & "$] Where [MALINCINSI] <> '' Group By [MALINCINSI]"
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1

    If Kayit_Seti.RecordCount > 0 Then
        S2.Cells(1, 15) = Now()
        S2.Cells(1, 15).Font.Bold = True
        
        For Each Urun_Grubu In Kayit_Seti.GetRows
            Sorgu = "Select * From [" & S1.Name & "$] Where [MALINCINSI] = '" & Urun_Grubu & "' Order By [DEPO] Asc"
            Veri_Seti.Open Sorgu, Baglanti, 1, 1
            If Veri_Seti.RecordCount > 0 Then
                Say = Veri_Seti.RecordCount
                With S2.Cells(Satir - 1, 1)
                    .Font.Bold = True
                    .Interior.Color = 14277081
                    .Value = Urun_Grubu
                    .Resize(, 15).MergeCells = True
                    '.HorizontalAlignment = xlCenter
                End With
                
                For Each Baslik In Veri_Seti.Fields
                    S2.Cells(Satir, Sutun) = Baslik.Name
                    Sutun = Sutun + 1
                Next
                
                S2.Range("A" & Satir & ":I" & Satir).Font.Bold = True
                S2.Cells(Satir + 1, 1).End(3)(2, 1).CopyFromRecordset Veri_Seti
                Satir = Satir + Say + 4
                Sutun = 1
            End If
            If Veri_Seti.State <> 0 Then Veri_Seti.Close
        Next
    End If

    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
    
    S2.Range("A:I").ColumnWidth = 255
    S2.Rows.AutoFit
    S2.Columns.AutoFit
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Baglanti = Nothing
    Set Kayit_Seti = Nothing
    Set Veri_Seti = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 

Ekli dosyalar

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,371
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba.

Tek tırnak ado için önemli, bu yüzden bence veri içindeki tek tırnakları kaldırmanız gerekir.
 
Katılım
4 Eylül 2020
Mesajlar
394
Excel Vers. ve Dili
Excel 2016
Altın Üyelik Bitiş Tarihi
22-11-2022
Merhaba veriler erp den sql ile çekilmektedir. Başka çözümü yokmudur acaba
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Kod:
Where [MALINCINSI] = '" & Urun_Grubu & "' Order By [DEPO] Asc"
Yukarıdaki kısmı aşağıdaki gibi değiştirerek deneyin.

Kod:
Where [MALINCINSI] Like '" & Replace(Urun_Grubu,"'","") & "%' Order By [DEPO] Asc"
 
Son düzenleme:
Katılım
4 Eylül 2020
Mesajlar
394
Excel Vers. ve Dili
Excel 2016
Altın Üyelik Bitiş Tarihi
22-11-2022
Merhaba hocam kodu denedim tırnak içerenleri hiç almadı sayafaya
 
Katılım
4 Eylül 2020
Mesajlar
394
Excel Vers. ve Dili
Excel 2016
Altın Üyelik Bitiş Tarihi
22-11-2022
Teşekkür ederim çalıştı
 
Üst