Sql Sorgusunda hem nümerik ve metinsel ifadeler

tamer42 · 17 Mayıs 2023

Merhaba,
Ekli dosyada Kaynak dosyasından Hedef dosyasına aşağıdaki kritere göre veri çekmeye çalışırken;

Hem Hedef dosyada hemde Kaynak dosyada Raf Numaraları hem 4 haneli nümerik ifade ( 4580) olabildiği gibi; 6 haneli ( 4580-1) gibi ifadeler de olabilmekte;

Aynı şekilde Beden alanı X, XXL, 2XL gibi metinsel ifadeler olabildiği gibi, 52, 48 gibi nümerik ifadeler olabilmekte;

Aşağıdaki özellikle Raf numarası 6 haneli olanlar gelmiyor,

Bu durmda aşağıdaki sorguyu nasıl düzenleyebiliriz?

ilginize şimdiden teşekkürler,

Kod:

Sub sorguu()
Dim Con As Object
Dim RS As Object
Dim SH As Worksheet
Dim LastRow As Long, i As Long, s As Integer
Dim myPath As String, myFile As String
Dim Renk As String, Beden As String
Dim RafNo As String, poz As Byte
    
Set SH = Sayfa1

LastRow = SH.Cells(SH.Rows.Count, "A").End(xlUp).Row

SH.Range("D2:D" & LastRow).ClearContents

Set Con = VBA.CreateObject("adodb.Connection")
Set RS = VBA.CreateObject("adodb.RecordSet")

myPath = ThisWorkbook.Path

myFile = myPath & "\KaynakDosya.xlsx"

Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
myFile & ";extended properties=""Excel 12.0;Hdr=Yes;IMEX=0"""

For i = 2 To LastRow

    RafNo = SH.Range("C" & i).Value

    poz = InStr(1, RafNo, "-", vbBinaryCompare)

    If poz > 0 Then
        Raf = Left(RafNo, 6)
    Else
        Raf = Left(RafNo, 4)
        If LCase(Raf) = "copy" Then Raf = Mid(RafNo, 5, 4)
    End If

    Beden = SH.Range("A" & i).Value
    Renk = SH.Range("B" & i).Value
   
  ''If Not IsNumeric(Raf) Then Raf = "'" & Raf & "'"
''  If Not IsNumeric(Beden) Then Beden = "'" & Beden & "'"
    
    
    sorgu = "Select [Ürün Adeti] From [sayfa$] " & _
    "Where [Raf Numarası] =" & Raf & " And [Beden] = '" & Beden & "' " & _
    "And [Renk] = '" & Renk & "' "
    
    
    RS.Open sorgu, Con, 3, 1
    
    s = RS.RecordCount
    If s > 0 Then
        SH.Range("D" & i).Value = RS(0)
    End If

RS.Close

RafNo = ""
Renk = ""
Beden = ""

Next i

Con.Close
Set Con = Nothing
Set SH = Nothing

End Sub

Korhan Ayhan · 17 Mayıs 2023

IMEX=1 olarak denediniz mi?

tamer42 · 17 Mayıs 2023

Korhan Ayhan' Alıntı:
IMEX=1 olarak denediniz mi?

IMEX=1 olarakta denedim Korhan Hocam,
değişen bir şey olmadı

Bu şekilde de denemler yaptım, o zaman işler daha da karıştı,

''If Not IsNumeric(Raf) Then Raf = "'" & Raf & "'"
'' If Not IsNumeric(Beden) Then Beden = "'" & Beden & "'"

teşekkürler,

Korhan Ayhan · 18 Mayıs 2023

Sorguyu aşağıdaki gibi değiştirip deneyiniz.

C++:

sorgu = "Select [Ürün Adeti] From [sayfa$] " & _
"Where [Raf Numarası]&'' ='" & Raf & "' And [Beden]&'' = '" & Beden & "' " & _
"And [Renk] = '" & Renk & "' "

tamer42 · 18 Mayıs 2023

Korhan Ayhan' Alıntı:
Sorguyu aşağıdaki gibi değiştirip deneyiniz.

C++:

sorgu = "Select [Ürün Adeti] From [sayfa$] " & _ "Where [Raf Numarası]&'' ='" & Raf & "' And [Beden]&'' = '" & Beden & "' " & _ "And [Renk] = '" & Renk & "' "

Korhan Hocam değişen bir durum olmadı,
4 haneli olanlarda sorun yok,
6 haneli (4969-1) Raf Numaralarında gelmiyor.

teşekkürler,
iyi Çalışmalar.

Kod:

   RafNo = SH.Range("C" & i).Value

    poz = InStr(1, RafNo, "-", vbBinaryCompare)

    If poz > 0 Then
        Raf = Left(RafNo, 6)
    Else
        Raf = Left(RafNo, 4)
        If LCase(Raf) = "copy" Then Raf = Mid(RafNo, 5, 4)
    End If

Korhan Ayhan · 20 Mayıs 2023

Böyle deneyiniz.

C++:

Sub sorguu()
    Dim Con As Object
    Dim RS As Object
    Dim SH As Worksheet
    Dim LastRow As Long, i As Long, s As Integer
    Dim myPath As String, myFile As String
    Dim Renk As String, Beden As String
    Dim RafNo As String, poz As Byte
        
    Set SH = Sayfa1
    
    LastRow = SH.Cells(SH.Rows.Count, "A").End(xlUp).Row
    
    SH.Range("D2:D" & LastRow).ClearContents
    
    Set Con = VBA.CreateObject("adodb.Connection")
    Set RS = VBA.CreateObject("adodb.RecordSet")
    
    myPath = ThisWorkbook.Path
    
    myFile = myPath & "\KaynakDosya.xlsx"
    
    Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    myFile & ";extended properties=""Excel 12.0;Hdr=No;IMEX=1"""
    
    For i = 2 To LastRow
    
        RafNo = SH.Range("C" & i).Value
    
        poz = InStr(1, RafNo, "-", vbBinaryCompare)
    
        If poz > 0 Then
            Raf = Left(RafNo, 6)
        Else
            Raf = Left(RafNo, 4)
            If LCase(Raf) = "copy" Then Raf = Mid(RafNo, 5, 4)
        End If
    
        Beden = SH.Range("A" & i).Value
        Renk = SH.Range("B" & i).Value
       
        sorgu = "Select F4 From [sayfa$] " & _
        "Where F3 ='" & Raf & "' And F1 = '" & Beden & "' " & _
        "And F2 = '" & Renk & "' "
        
        RS.Open sorgu, Con, 3, 1
        
        s = RS.RecordCount
        If s > 0 Then
            SH.Range("D" & i).Value = CDbl(RS(0))
        End If
    
    RS.Close
    
    RafNo = ""
    Renk = ""
    Beden = ""
    
    Next i
    
    Con.Close
    Set Con = Nothing
    Set SH = Nothing
End Sub

tamer42 · 20 Mayıs 2023

Korhan Ayhan' Alıntı:

Böyle deneyiniz.

C++:

Sub sorguu()
    Dim Con As Object
    Dim RS As Object
    Dim SH As Worksheet
    Dim LastRow As Long, i As Long, s As Integer
    Dim myPath As String, myFile As String
    Dim Renk As String, Beden As String
    Dim RafNo As String, poz As Byte
       
    Set SH = Sayfa1
   
    LastRow = SH.Cells(SH.Rows.Count, "A").End(xlUp).Row
   
    SH.Range("D2:D" & LastRow).ClearContents
   
    Set Con = VBA.CreateObject("adodb.Connection")
    Set RS = VBA.CreateObject("adodb.RecordSet")
   
    myPath = ThisWorkbook.Path
   
    myFile = myPath & "\KaynakDosya.xlsx"
   
    Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    myFile & ";extended properties=""Excel 12.0;Hdr=No;IMEX=1"""
   
    For i = 2 To LastRow
   
        RafNo = SH.Range("C" & i).Value
   
        poz = InStr(1, RafNo, "-", vbBinaryCompare)
   
        If poz > 0 Then
            Raf = Left(RafNo, 6)
        Else
            Raf = Left(RafNo, 4)
            If LCase(Raf) = "copy" Then Raf = Mid(RafNo, 5, 4)
        End If
   
        Beden = SH.Range("A" & i).Value
        Renk = SH.Range("B" & i).Value
      
        sorgu = "Select F4 From [sayfa$] " & _
        "Where F3 ='" & Raf & "' And F1 = '" & Beden & "' " & _
        "And F2 = '" & Renk & "' "
       
        RS.Open sorgu, Con, 3, 1
       
        s = RS.RecordCount
        If s > 0 Then
            SH.Range("D" & i).Value = CDbl(RS(0))
        End If
   
    RS.Close
   
    RafNo = ""
    Renk = ""
    Beden = ""
   
    Next i
   
    Con.Close
    Set Con = Nothing
    Set SH = Nothing
End Sub

şimdi oldu Korhan Hocam,
olayın püf noktası neydi? Başlıkların olmaması mı?

teşekkürler,

Sql Sorgusunda hem nümerik ve metinsel ifadeler

tamer42

Destek Ekibi

Ekli dosyalar

Korhan Ayhan

Administrator

tamer42

Destek Ekibi

Korhan Ayhan

Administrator

tamer42

Destek Ekibi

Korhan Ayhan

Administrator

tamer42

Destek Ekibi