Mohon bantuan : Pull Data Query Access dari Input Tabel Excel

  1. 5 bulan yang lalu
    Di sunting 5 bulan yang lalu oleh Ohidayat

    salam,

    mohon bantuannya, karena saya stuck di konsep loop dengan query. kebetulan saya memiliki data di access, dan rencananya hanya data terpilih saja dari halaman "input" (cell,lcel, dan tanggal tertentu) yang akan muncul di halaman "output" excel ketika menekan tombol proses.

    sampai sini saya sudah coba baca baca belum menemukan solusi. mohon bantuannya. berikut saya sertakan datanya.

    terima kasih

  2. Caton

    Jul 7 Terverifikasi Indonesia + 17.741 Poin

    @Ohidayat ...

    Pada tabel berikut :

    -image-

    saya asumsikan untuk DAY START dan DAY END korelasinya ke field xDate pada tabel DATA dalam Access. Untuk LCEL dan CELL itu korelasinya pada field apa?

  3. @Caton terima kasih sudah merespons , untuk LCEL berkorelasi dengan LBTS_ID dan CELL berkorelasi dengan LCEL_ID

    saya sudah mencoba menyelesaikan looping dan query untuk cell (sementara tanpa date), kondisinya sekarang terkait kode untuk menentukan akhir rows, dimana data akan di paste. karena selalu saja posisinya data ketika di paste tidak berapa di akhir rows [Range(Selection, Selection.End(xlDown)).Select]

    Sub queryAccess()
    
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sQRY, id1, id2 As String
    Dim strFilePath As String
    Dim colominput, rowfilter, rowpaste As Integer
    
    Application.ScreenUpdating = False
    
    strFilePath = "c:\Users\ohidayat\Documents\TEMP\DATA.accdb" 'Database name and path
    Set cnn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    
    
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source= c:\Users\ohidayat\Documents\TEMP\DATA.accdb;"
    
    rowfilter = 1
    colominput = 0
    Do
    id1 = Sheets("input").Range("A1").Offset(rowfilter, colominput).Value
    id2 = Sheets("input").Range("A1").Offset(rowfilter, colominput + 1).Value
    Do
    If Sheets("input").Range("A1").Offset(rowfilter + 1, colominput).Value = id1 Then
        rowfilter = rowfilter + 1
        id2 = id2 & "," & Sheets("input").Range("A1").Offset(rowfilter, colominput + 1).Value
    End If
    
    Loop Until Sheets("input").Range("A1").Offset(rowfilter + 1, colominput).Value <> id1
    sQRY = "SELECT DATA.xDate, DATA.MRBTS_ID, DATA.LNBTS_ID, DATA.LNCEL_ID, DATA.DL_PAYLOAD_MB, DATA.UL_PAYLOAD_MB FROM Data WHERE ((DATA.LNBTS_ID)=" & id1 & ") AND DATA.LNCEL_ID IN (" & id2 & ");"
    
    rs.CursorLocation = adUseClient
    rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
    Application.ScreenUpdating = False
    
    Sheets("OUTPUT").Select
        Range("A1").Select
       ' Selection.SpecialCells(xlCellTypeLastCell).Select
        Range(Selection, Selection.End(xlDown)).Select
        lokasi = Selection.Address
    temp = Split(lokasi, "$")
    rowpaste = temp(1) + 1
    Worksheets("Output").Range("A1").Offset(rowpaste, 0).CopyFromRecordset rs 'Where to place the data
    
    rowfilter = rowfilter + 1
    Loop Until Sheets("input").Range("A1").Offset(rowfilter, colominput).Value = ""
    
    
    rs.Close
    Set rs = Nothing
    cnn.Close
    Set cnn = Nothing
    
    Exit Sub
    
    End Sub
    
    
    

  4. Caton

    Jul 7 Terverifikasi Indonesia + 17.741 Poin

    @Ohidayat ...

    Menurut saya, baris script berikut yang menjadi masalah:

    Worksheets("Output").Range("A1").Offset(rowpaste, 0).CopyFromRecordset rs

    Karena untuk pengulangan pertama, script di atas benar, karena data akan ditempelkan pada baris ke-1 kolom ke-1. Tapi pada saat pengulangan kedua, mustinya temukan dahulu baris terkahir dari data yang ada, misalkan :

    ...
    lBaris = Worksheets("Output").Cells(Rows.Count, 1).End(xlUp).Row
    If lBaris > 1 then lBaris = lBaris + 1
    Worksheets("Output").Range("A" & lBaris).CopyFromRecordset rs
    ...

    Pada contoh script di atas, untuk pengulangan pertama, maka lBaris akan bernilai 1 (dengan asumsi Sheet OUTPUT tidak ada datanya). Kemudian pada pengulangan kedua, maka lBaris akan bernilai baris terakhir dari data hasil sebelumnya. Misalkan sebelumnya ada 100 baris, maka pada pengulangan kedua, lBaris akan bernilai 100. Dengan baris script :

    If lBaris > 1 then lBaris = lBaris + 1

    maka nilai lBaris akan menjadi 101. Demikian seterusnya.

  5. Caton

    Jul 7 Terverifikasi Indonesia + 17.741 Poin

    @Ohidayat ...

    Berikut contoh script yang saya coba :

    Public Sub QueryAccessData()
        Dim sDataPath As String, sQuery As String
        Dim dbConn As Connection, dbRS As Recordset
        Dim vParams As Variant
        Dim lR As Long, lRow As Long, lIdx As Long
        
        lRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
        If lRow > 1 Then
            Set dbConn = New ADODB.Connection
            Set dbRS = New ADODB.Recordset
            
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            
            Sheet2.Activate
            Sheet2.Cells.Delete
            
            '+-- Ganti ThisWorkbook.Path dengan folder aktual.
            sDataPath = ThisWorkbook.Path & "\DATA.accdb"
            dbConn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source = " & sDataPath
        
            For lR = 2 To lRow
                With Sheet1
                    '+-- Kriteria.
                    vParams = Array( _
                        "#" & Format(CDate(.Range("D1")), "mm/dd/yyyy") & "#", _
                        "#" & Format(CDate(.Range("D2")), "mm/dd/yyyy") & "#", _
                        .Cells(lR, 1), .Cells(lR, 2) _
                    )
                End With
        
                sQuery = vbNullString
                sQuery = sQuery & "SELECT DATA.* FROM Data WHERE "
                sQuery = sQuery & "(((DATA.xDate)>=" & vParams(0) & " " & _
                    "AND (DATA.xDate)<=" & vParams(1) & ") " & _
                    "AND ((DATA.LNBTS_ID)=" & vParams(2) & ") " & _
                    "AND ((DATA.LNCEL_ID)=" & vParams(3) & ")) "
            
                dbRS.CursorLocation = adUseClient
                dbRS.Open sQuery, dbConn, adOpenStatic, adLockReadOnly
                Debug.Print dbRS.RecordCount
                
                lRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
                If lRow > 1 Then lRow = lRow + 1
                Sheet2.Range("A" & lRow).CopyFromRecordset dbRS
                dbRS.Close
            Next
            
            Application.EnableEvents = False
            Application.ScreenUpdating = True
        
            dbConn.Close
            Set dbRS = Nothing
            Set dbConn = Nothing
        End If
    End Sub

    Demikian, semoga sesuai harapan.

  6. Caton

    Jul 7 Terverifikasi Indonesia + 17.741 Poin

    Koreksi sedikit pada baris :

    lRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
    If lRow > 1 Then lRow = lRow + 1
    Sheet2.Range("A" & lRow).CopyFromRecordset dbRS

    ganti dengan :

    lIdx = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
    If lIdx > 1 Then lIdx = lIdx + 1
    Sheet2.Range("A" & lIdx).CopyFromRecordset dbRS

    Demikian.

  7. terima kasih banyak om @Caton sudah mau di repotin, ini script lebih efektif dibandingan dengan yang saya. mohon maaf sudah merepotkan

  8. Caton

    Jul 7 Terverifikasi Indonesia + 17.741 Poin

    @Ohidayat ...

    Sama-sama mas, senang bisa membantu... dan tak perlu mohon maaf karena mas tidak punya salah sama saya... :D

  9. Caton

    Jul 7 Terverifikasi Indonesia + 17.741 Poin

    @Ohidayat...

    Koreksi lagi... :D Pada baris terakhir,

    ... 
    Application.EnableEvents = False
    Application.ScreenUpdating = True
        
    dbConn.Close
    ... 

    ubah baris Application.EnableEvents = False menjadi Application.EnableEvents = True, seperti berikut :

    ... 
    '+-- Koreksi baris yang ini saja. 
    Application.EnableEvents = True
    Application.ScreenUpdating = True
        
    dbConn.Close
    ... 

    Demikian.

  10. terima kasih banyak om @Caton kebetulan untuk event tersebut sudah saya enable

  11. Di sunting 5 bulan yang lalu oleh Ohidayat

    om @Caton maaf mau bertanya kembali, kenapa apabila saya memasukan dua digit data di kolom "cell" hanya menghasilkan data di row terakhir saja yang di record yah?. kalau dari variable variant seharusnya tidak ada kendala dengan array. apa mungkin dari db accessnya

    semisal saya mengubah LCEL dari angka menjadi gabungan huruf dengan angka semisal (AG2030), karena bentuk variable nya variant apa mungkin nanti di buat tanpa array saja yah? sehingga bisa digunakan text

  12. Caton

    Jul 8 Terverifikasi Indonesia + 17.741 Poin

    @Ohidayat ...

    Saya tidak tahu masalahnya dimana. Contoh data yang ada pada saya untuk field LCEL tidak ada data = 273005 dan data pada field CELL tidak ada data > 10. Kalau saya kueri hasilnya tidak ada. Mungkin, bisa dicoba dahulu kueri terhadap data tersebut di Access, apakah ada datanya atau tidak.

    Kalau dugaan masalahnya ada array vParams, bisa dicoba menggunakan teks biasa untuk kuerinya. Array vParams tidak mutlak digunakan. Saya menggunakan variabel vParams tersebut hanya untuk memudahkan saya dalam mengutak atik parameter kueri yang akan saya gunakan tanpa harus mengubah variabel kueri sebenarnya (sQuery). Tapi pada dasarnya tipe variabel vParams adalah string (teks).

    Demikian.

  13. terima kasih banyak om @Caton, ternyata kendalanya di database access saya. tadi coba coba di ubah apabila menggunakan dua digit data dan apabila menggunakan kombinasi angka dan huruf.

 

atau Mendaftar untuk ikut berdiskusi!