• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro Tek tırnak hatası

Katılım
4 Eylül 2020
Mesajlar
394
Excel Vers. ve Dili
Excel 2016
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

Merhaba.

Tek tırnak ado için önemli, bu yüzden bence veri içindeki tek tırnakları kaldırmanız gerekir.
 
Merhaba veriler erp den sql ile çekilmektedir. Başka çözümü yokmudur acaba
 
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:
Merhaba hocam kodu denedim tırnak içerenleri hiç almadı sayafaya
 
Geri
Üst