Kapalı Excel CSV Dosyasından Filtre yaparak İstenen Sütunlardaki Değerleri alma.

[1mak1mak]

Merhaba
Ekte Pay Ölçer Cihazının verdiği verileri Süzerek gerekli olan sütunları almak istedim buna benzer bir dosyam var orda 2 farklı csv dosyasından verileri alıyorum.
Aşağıdaki xlsm dosyasına bunu uygulamaya çalıştım ama olmadı. İstediğim ekte paylaştığım Arşiv dosyasında DGaz.csv Dosyasından DGaz_x.xlsm dosyasına
csv dosyası kapalıyken verileri düzenli bir şekilde çekmek istiyorum. Adres C:\Test olarak çalışıyor ama her iki dosyada aynı Klasörde olacağından adressiz de olabilir.
Ekte Süzerek Filtre ile İstediğim şeklide gösteren Resmi paylaşıyorum.
Şimdiden Destekleriniz için teşekkürler.

 

[veyselemre]

Sub csvVeriAl()
    Dim csvName$, satirlar, sat, conStr$, i%, _
    mySchemaFile, con As Object, cmd As Object, rs As Object
    csvName = "DGaz.csv"

    satirlar = Array("[" & csvName & "]", _
                     "ColNameHeader=False", _
                     "StartRow=1", _
                     "Format=Delimited(;)", _
                     "CharacterSet=ANSI", _
                     "DateFormat=dd.mm.yyyy", _
                     "DecimalSymbol=.")

    mySchemaFile = ActiveWorkbook.Path & "\Schema.ini"
    Open mySchemaFile For Output As #1
    For Each sat In satirlar
        Print #1, sat
    Next sat
    Close #1

    #If Win64 Then
        conStr = "Driver=Microsoft Access Text Driver (*.txt, *.csv);" & _
                 "Dbq=" & ThisWorkbook.Path & ";Extensions=asc,csv,tab,txt;"
    #Else
        conStr = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
                 "Dbq=" & ThisWorkbook.Path & ";Extensions=asc,csv,tab,txt;"
    #End If

    Set con = CreateObject("ADODB.Connection")
    con.ConnectionString = conStr
    con.Open
    Set cmd = CreateObject("ADODB.Command")
    cmd.ActiveConnection = con
    cmd.CommandText = "SELECT FIRST(F1) AS Location, FIRST(F2) AS [Date], FIRST(F5) AS [ID-NO], FIRST(F8) AS [Value] " & _
                      "FROM DGaz.csv GROUP BY F5 ORDER BY FIRST(F1)"
    
    Set rs = cmd.Execute()

    Cells.Clear
    For i = 0 To rs.Fields.Count - 1
        Cells(1, i + 1) = rs.Fields(i).Name
    Next
    Range("A1:D1").Font.Bold = True
    [a2].CopyFromRecordset rs
    Kill mySchemaFile
    i = Cells(Rows.Count, 1).End(3).Row
    With Cells(i + 1, 4)
        .FormulaR1C1 = "=SUM(R2C4:R[-1]C4)"
        .Value = .Value
        .Offset(, -1) = "TOPLAM"
    
    End With
    Cells(2, 4).Resize(i - 1).NumberFormat = "#,##0.00"

End Sub

 

[1mak1mak]

Sub csvVeriAl()
    Dim csvName$, satirlar, sat, conStr$, i%, _
    mySchemaFile, con As Object, cmd As Object, rs As Object
    csvName = "DGaz.csv"

    satirlar = Array("[" & csvName & "]", _
                     "ColNameHeader=False", _
                     "StartRow=1", _
                     "Format=Delimited(;)", _
                     "CharacterSet=ANSI", _
                     "DateFormat=dd.mm.yyyy", _
                     "DecimalSymbol=.")

    mySchemaFile = ActiveWorkbook.Path & "\Schema.ini"
    Open mySchemaFile For Output As #1
    For Each sat In satirlar
        Print #1, sat
    Next sat
    Close #1

    #If Win64 Then
        conStr = "Driver=Microsoft Access Text Driver (*.txt, *.csv);" & _
                 "Dbq=" & ThisWorkbook.Path & ";Extensions=asc,csv,tab,txt;"
    #Else
        conStr = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
                 "Dbq=" & ThisWorkbook.Path & ";Extensions=asc,csv,tab,txt;"
    #End If

    Set con = CreateObject("ADODB.Connection")
    con.ConnectionString = conStr
    con.Open
    Set cmd = CreateObject("ADODB.Command")
    cmd.ActiveConnection = con
    cmd.CommandText = "SELECT FIRST(F1) AS Location, FIRST(F2) AS [Date], FIRST(F5) AS [ID-NO], FIRST(F8) AS [Value] " & _
                      "FROM DGaz.csv GROUP BY F5 ORDER BY FIRST(F1)"
   
    Set rs = cmd.Execute()

    Cells.Clear
    For i = 0 To rs.Fields.Count - 1
        Cells(1, i + 1) = rs.Fields(i).Name
    Next
    Range("A1:D1").Font.Bold = True
    [a2].CopyFromRecordset rs
    Kill mySchemaFile
    i = Cells(Rows.Count, 1).End(3).Row
    With Cells(i + 1, 4)
        .FormulaR1C1 = "=SUM(R2C4:R[-1]C4)"
        .Value = .Value
        .Offset(, -1) = "TOPLAM"
   
    End With
    Cells(2, 4).Resize(i - 1).NumberFormat = "#,##0.00"

End Sub

Teşekkür ederim ellerinize sağlık çok güzel olmuş.

 

[hamitcan]

Aşağıdaki dosyayı dener misiniz ?

 

[1mak1mak]

Aşağıdaki dosyayı dener misiniz ?

Hamit bey merhaba
Denedim evet Filtreli geliyor ancak bütün sütuları almış ben sadece resimdeki sütunları almak istiyordum.
Veysel beyin verdiği Kod işimi gördü güzel çalışıyor. İsterseniz sizi yormayayım.
İlginiz için Teşekkürler