Sql sorgusunda alan değeri' ne göre alan adlarını alma

tamer42 · Perşembe saat 15:46'de

Merhabalar,

Ekli dosyada aşağıdaki sorguya uyacak ;
"Data sayfasında "G" - "AJ" sütunları arasında kontrol ederek; burada değerler 0' dan büyük olanların alan adlarını alacak;

Özetle Matris prosediründe yer alan işlemleri SQL sorgusu ile yapmak...

desteğiniz için şimdiden teşekkürler,

Kod:

Set SH = Sayfa2
key = SH.Range("C2").Value & SH.Range("C3").Value
sorgu = "Select * " & _
                "From [Data$] " & _
                "Where [ANAHTAR] Like '" & key & "' "

Kod:

Sub Matris()
Dim SHT As Worksheet
Dim rw As Long
Dim r As Integer
Dim c As Integer

Application.Calculation = xlCalculationManual

Set SH = Sayfa2
Set SHT = Sayfa1

SH.Range("B6:B1000").ClearContents

If SH.Range("E1") <> "" Then
    rw = SH.Range("E1").Value
End If

If rw = 0 Then Exit Sub

r = 6

For c = 7 To 36
    
    If SHT.Cells(rw, c).Value > 0 Then
        SH.Range("B" & r) = SHT.Cells(1, c).Value
    
        r = r + 1
    
    End If

Next c


Application.Calculation = xlCalculationAutomatic

Set SH = Nothing
Set SHT = Nothing

End Sub

iyi çalışmalar.

muhasebeciyiz · Perşembe saat 16:19'de

Tamer Hocam ; size bilgi mahiyetinde dikkatinize sunuyorum.

Option Explicit

Dim Con As Object
Dim SH As Worksheet
Dim SHT As Worksheet

Sub baglan()
Dim yol As String
Set Con = CreateObject("ADODB.Connection")
yol = ThisWorkbook.FullName
Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
yol & ";extended properties=""Excel 12.0;hdr=yes"""
End Sub

Sub SQL_Matris()
Dim RS As Object
Dim sorgu As String
Dim rw As Long
Dim i As Integer
Dim headers As Variant
Dim r As Integer

Application.Calculation = xlCalculationManual

Set SH = ThisWorkbook.Sheets("Sayfa2")
Set SHT = ThisWorkbook.Sheets("Sayfa1") ' Data sayfası yerine Sayfa1

' Clear existing data in B6:B1000
SH.Range("B6:B1000").ClearContents

' Get row number from E1
If SH.Range("E1").Value <> "" Then
rw = SH.Range("E1").Value
Else
rw = 0
End If

If rw = 0 Then
Application.Calculation = xlCalculationAutomatic
Set SH = Nothing
Set SHT = Nothing
Exit Sub
End If

' Call baglan to establish connection
baglan

' Get headers from G1:AJ1
headers = SHT.Range("G1:AJ1").Value

' SQL query to select specific row from Sayfa1 (assuming table-like structure)
sorgu = "SELECT * FROM [Sayfa1$G" & rw & ":AJ" & rw & "]"

On Error Resume Next ' Handle potential SQL errors
Set RS = Con.Execute(sorgu)
On Error GoTo 0

If Not RS Is Nothing And Not RS.EOF Then
r = 6
' Loop through fields (columns G to AJ)
For i = 0 To RS.Fields.Count - 1
If IsNumeric(RS.Fields(i).Value) And RS.Fields(i).Value > 0 Then
SH.Range("B" & r).Value = headers(1, i + 1) ' Match header with field
r = r + 1
End If
Next i
Else
MsgBox "No data found for row " & rw & " or SQL query failed.", vbExclamation
End If

' Clean up
If Not RS Is Nothing Then
RS.Close
Set RS = Nothing
End If
If Not Con Is Nothing Then
Con.Close
Set Con = Nothing
End If

Application.Calculation = xlCalculationAutomatic
Set SH = Nothing
Set SHT = Nothing
End Sub

Kod:

Sub Matris_Optimized()
    Dim rw As Long
    Dim r As Integer
    Dim c As Integer

    Application.Calculation = xlCalculationManual

    Set SH = ThisWorkbook.Sheets("Sayfa2")
    Set SHT = ThisWorkbook.Sheets("Sayfa1")

    SH.Range("B6:B1000").ClearContents

    If SH.Range("E1").Value <> "" Then
        rw = SH.Range("E1").Value
    End If

    If rw = 0 Then
        Application.Calculation = xlCalculationAutomatic
        Set SH = Nothing
        Set SHT = Nothing
        Exit Sub
    End If

    r = 6
    For c = 7 To 36
        If SHT.Cells(rw, c).Value > 0 Then
            SH.Range("B" & r).Value = SHT.Cells(1, c).Value
            r = r + 1
        End If
    Next c

    Application.Calculation = xlCalculationAutomatic
    Set SH = Nothing
    Set SHT = Nothing
End Sub

SQL kullanmak zorunlu değilse, yukaraki gibii bir VBA tabanlı çözüm önerilmekte

Kod:

Sub SQL_Matris_Alternative()
    Dim RS As Object
    Dim sorgu As String
    Dim rw As Long
    Dim headers As Variant
    Dim r As Integer
    Dim i As Integer

    Application.Calculation = xlCalculationManual

    Set SH = ThisWorkbook.Sheets("Sayfa2")
    Set SHT = ThisWorkbook.Sheets("Sayfa1")

    SH.Range("B6:B1000").ClearContents

    If SH.Range("E1").Value <> "" Then
        rw = SH.Range("E1").Value
    Else
        rw = 0
    End If

    If rw = 0 Then
        Application.Calculation = xlCalculationAutomatic
        Set SH = Nothing
        Set SHT = Nothing
        Exit Sub
    End If

    baglan

    ' Get headers
    headers = SHT.Range("G1:AJ1").Value

    ' SQL query to select the entire row
    sorgu = "SELECT * FROM [Sayfa1$] WHERE [RowID] = " & rw ' Assuming RowID is a column identifying the row number
    ' Note: Sayfa1$'de bir RowID sütunu olmalı veya satır numarasını başka şekilde filtrelemelisiniz

    On Error Resume Next
    Set RS = Con.Execute(sorgu)
    On Error GoTo 0

    If Not RS Is Nothing And Not RS.EOF Then
        r = 6
        For i = 6 To 35 ' G to AJ (0-based index for Fields, adjusted for G:AJ)
            If IsNumeric(RS.Fields(i).Value) And RS.Fields(i).Value > 0 Then
                SH.Range("B" & r).Value = headers(1, i - 5) ' Adjust index for headers
                r = r + 1
            End If
        Next i
    Else
        MsgBox "No data found for row " & rw, vbExclamation
    End If

    If Not RS Is Nothing Then
        RS.Close
        Set RS = Nothing
    End If
    If Not Con Is Nothing Then
        Con.Close
        Set Con = Nothing
    End If

    Application.Calculation = xlCalculationAutomatic
    Set SH = Nothing
    Set SHT = Nothing
End Sub

Sayfa1'deki veriyi bir tablo gibi yapılandırmanız gerekir (örneğin, G:AJ sütunlarının başlıkları net olmalı). Alternatif olarak, tüm satırı SQL ile çekip VBA ile filtreleyebilirsiniz.SQL ile devam ederseniz bunu kullanın denilmekte

Dikkatinize sunulur.Saygılarımla

muhasebeciyiz · Perşembe saat 16:35'de

Kod:

Option Explicit

Dim Con As Object
Dim SH As Worksheet
Dim SHT As Worksheet

Sub baglan()
    Dim yol As String
    Set Con = CreateObject("ADODB.Connection")
    yol = ThisWorkbook.FullName
    Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
             yol & ";extended properties=""Excel 12.0;hdr=yes"""
End Sub

Sub Matris_SQL()
    Dim RS As Object
    Dim sorgu As String
    Dim rw As Long
    Dim r As Integer
    Dim headers As Variant
    Dim values As Variant
    Dim i As Integer
    Dim result As String

    Application.Calculation = xlCalculationManual

    Set SH = ThisWorkbook.Sheets("Sayfa2")
    Set SHT = ThisWorkbook.Sheets("Sayfa1")

    ' Clear existing data in B6:B1000
    SH.Range("B6:B1000").ClearContents

    ' Get the row number from E1
    If SH.Range("E1").Value <> "" Then
        rw = SH.Range("E1").Value
    Else
        rw = 0
    End If

    If rw = 0 Then
        Application.Calculation = xlCalculationAutomatic
        Set SH = Nothing
        Set SHT = Nothing
        Exit Sub
    End If

    ' Call baglan to establish connection
    baglan

    ' Get headers and values for columns G to AJ (7 to 36)
    headers = SHT.Range("G1:AJ1").Value ' 1st row headers
    values = SHT.Range("G" & rw & ":AJ" & rw).Value ' Specified row values

    ' Build result list of headers where value > 0
    r = 6
    For i = 1 To UBound(headers, 2)
        If values(1, i) > 0 Then
            SH.Range("B" & r).Value = headers(1, i)
            r = r + 1
        End If
    Next i

    Application.Calculation = xlCalculationAutomatic

    ' Clean up
    If Not Con Is Nothing Then
        Con.Close
        Set Con = Nothing
    End If
    Set SH = Nothing
    Set SHT = Nothing
End Sub

Açıklamalar:

SQL ile Zorluklar: Excel'de ADODB ile SQL sorguları genellikle tablo benzeri veriler için tasarlanmıştır. Sayfa1'deki G'den AJ'ye sütunlardaki belirli bir satırın değerlerini kontrol etmek ve sadece başlıkları almak için doğrudan bir SQL sorgusu yazmak karmaşık olabilir, çünkü SQL genellikle satır bazlı filtreleme yapar, sütun bazlı değil. Bu nedenle, yukarıdaki kodda VBA ile başlıkları ve değerleri doğrudan almayı tercih ettim, ancak ADODB bağlantısını korudum.
Alternatif SQL Yaklaşımı: Eğer mutlaka SQL kullanmak isterseniz, her sütunu ayrı ayrı sorgulamak yerine, bir geçici tablo oluşturabilir veya veriyi bir ADODB Recordset'ine çekip VBA ile filtreleyebilirsiniz. Ancak, bu durumda sütun sayısı fazla olduğu için (G'den AJ'ye, yani 30 sütun), her sütun için ayrı bir sorgu yazmak pratik olmayabilir. Bunun yerine, yukarıdaki kodda VBA'nın Range nesnesini kullanarak daha verimli bir çözüm sundum.
Kodun Çalışma Mantığı:
- Sayfa2'deki E1 hücresinden satır numarasını (rw) alır.
- Sayfa1'deki G1:AJ1 aralığından başlıkları ve belirtilen satırdan (rw) değerleri çeker.
- Değeri 0'dan büyük olan sütunların başlıklarını Sayfa2'nin B sütununa 6. satırdan itibaren yazar.
- ADODB bağlantısını baglan prosedürü ile kurar, ancak bu örnekte SQL yerine VBA ile veri işleme yapıldı.
SQL ile Tam Çözüm: Eğer verileriniz Sayfa1$'de tablo formatında (örneğin, her sütunun bir başlığı var ve satırlar düzenli veri içeriyor) ise, aşağıdaki gibi bir SQL sorgusu denenebilir, ancak bu, sütunların dinamik olarak seçilmesini zorlaştırır:

sorgu = "SELECT * FROM [Sayfa1$] WHERE F1 = " & rw
Set RS = Con.Execute(sorgu)

Bu sorgu, Sayfa1$'deki belirli bir satırı alır, ancak G'den AJ'ye sütunlardaki değerleri kontrol etmek için ek VBA mantığı gerekir. Bu nedenle, yukarıdaki kod daha doğrudan ve etkili bir çözüm sunar.

Bunlar size bilgi olarak sunulmuştur kendi çabamız değil

tamer42 · Perşembe saat 17:05'de

muhasebeciyiz' Alıntı:
Kod:

Option Explicit Dim Con As Object Dim SH As Worksheet Dim SHT As Worksheet Sub baglan() Dim yol As String Set Con = CreateObject("ADODB.Connection") yol = ThisWorkbook.FullName Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _ yol & ";extended properties=""Excel 12.0;hdr=yes""" End Sub Sub Matris_SQL() Dim RS As Object Dim sorgu As String Dim rw As Long Dim r As Integer Dim headers As Variant Dim values As Variant Dim i As Integer Dim result As String Application.Calculation = xlCalculationManual Set SH = ThisWorkbook.Sheets("Sayfa2") Set SHT = ThisWorkbook.Sheets("Sayfa1") ' Clear existing data in B6:B1000 SH.Range("B6:B1000").ClearContents ' Get the row number from E1 If SH.Range("E1").Value <> "" Then rw = SH.Range("E1").Value Else rw = 0 End If If rw = 0 Then Application.Calculation = xlCalculationAutomatic Set SH = Nothing Set SHT = Nothing Exit Sub End If ' Call baglan to establish connection baglan ' Get headers and values for columns G to AJ (7 to 36) headers = SHT.Range("G1:AJ1").Value ' 1st row headers values = SHT.Range("G" & rw & ":AJ" & rw).Value ' Specified row values ' Build result list of headers where value > 0 r = 6 For i = 1 To UBound(headers, 2) If values(1, i) > 0 Then SH.Range("B" & r).Value = headers(1, i) r = r + 1 End If Next i Application.Calculation = xlCalculationAutomatic ' Clean up If Not Con Is Nothing Then Con.Close Set Con = Nothing End If Set SH = Nothing Set SHT = Nothing End Sub

Açıklamalar:

SQL ile Zorluklar: Excel'de ADODB ile SQL sorguları genellikle tablo benzeri veriler için tasarlanmıştır. Sayfa1'deki G'den AJ'ye sütunlardaki belirli bir satırın değerlerini kontrol etmek ve sadece başlıkları almak için doğrudan bir SQL sorgusu yazmak karmaşık olabilir, çünkü SQL genellikle satır bazlı filtreleme yapar, sütun bazlı değil. Bu nedenle, yukarıdaki kodda VBA ile başlıkları ve değerleri doğrudan almayı tercih ettim, ancak ADODB bağlantısını korudum.

Alternatif SQL Yaklaşımı: Eğer mutlaka SQL kullanmak isterseniz, her sütunu ayrı ayrı sorgulamak yerine, bir geçici tablo oluşturabilir veya veriyi bir ADODB Recordset'ine çekip VBA ile filtreleyebilirsiniz. Ancak, bu durumda sütun sayısı fazla olduğu için (G'den AJ'ye, yani 30 sütun), her sütun için ayrı bir sorgu yazmak pratik olmayabilir. Bunun yerine, yukarıdaki kodda VBA'nın Range nesnesini kullanarak daha verimli bir çözüm sundum.

Kodun Çalışma Mantığı:

Sayfa2'deki E1 hücresinden satır numarasını (rw) alır.

Sayfa1'deki G1:AJ1 aralığından başlıkları ve belirtilen satırdan (rw) değerleri çeker.

Değeri 0'dan büyük olan sütunların başlıklarını Sayfa2'nin B sütununa 6. satırdan itibaren yazar.

ADODB bağlantısını baglan prosedürü ile kurar, ancak bu örnekte SQL yerine VBA ile veri işleme yapıldı.

SQL ile Tam Çözüm: Eğer verileriniz Sayfa1$'de tablo formatında (örneğin, her sütunun bir başlığı var ve satırlar düzenli veri içeriyor) ise, aşağıdaki gibi bir SQL sorgusu denenebilir, ancak bu, sütunların dinamik olarak seçilmesini zorlaştırır:

sorgu = "SELECT * FROM [Sayfa1$] WHERE F1 = " & rw
Set RS = Con.Execute(sorgu)

Bu sorgu, Sayfa1$'deki belirli bir satırı alır, ancak G'den AJ'ye sütunlardaki değerleri kontrol etmek için ek VBA mantığı gerekir. Bu nedenle, yukarıdaki kod daha doğrudan ve etkili bir çözüm sunar.

Bunlar size bilgi olarak sunulmuştur kendi çabamız değil

Çok Teşekkür ederim Hocam
iyi Çalışamalrar.

Sql sorgusunda alan değeri' ne göre alan adlarını alma

tamer42

Destek Ekibi

Ekli dosyalar

muhasebeciyiz

muhasebeciyiz

tamer42

Destek Ekibi