Thảo luận về bài: ADO căn bản "Kết nối truy vấn CSDL từ file Excel đến file Access."

Liên hệ QC
Thực ra em chưa rõ sự liên quan giữa nơi làm việc và nhân viên vì thế chưa đưa ra được kết quả đúng theo yêu cầu.
E thử mô tả lại thế này:
1 ông nhân viên, có thể làm nhiều nơi khác nhau, mỗi nơi có một vài sản phẩm nào đó. Có thể có trường hợp cùng một nơi có nhiều nhóm số lượng sản phẩm.
Yêu cầu đầu bài là nhóm lại tổng sản phẩm theo nơi làm việc của ông ta và đưa vào diễn giải.
Nếu vậy thì em xin mạn phép đưa câu trả lời như trong file đính kèm.
PHP:
Function FlattenQry(ID As String) As String
    Dim Sql As String
    
    Sql = "SELECT NoiLamViec, Sum(SoLuong) AS SumOfSoLuong " & _
        "FROM NhanVien WHERE MaNV='" & ID & "' GROUP BY NoiLamViec;"
    Dim Rcs As Object, cn As Connection
    Set Rcs = CurrentProject.AccessConnection.Execute(Sql)
    Sql = ""
    While Not Rcs.EOF
        Sql = Sql & ", " & Rcs.Fields(0) & " (" & Rcs.Fields(1) & ")"
        Rcs.MoveNext
    Wend
    FlattenQry = IIf(Sql = "", "", Mid(Sql, 3))
    Rcs.Close
End Function
pictures.jpg
 

File đính kèm

  • ThuNghiem.zip
    14 KB · Đọc: 37
Lần chỉnh sửa cuối:
Trong module:

Mã:
Option Compare Database

Public Function ConcatenateStr(strField As String, strField1 As String, _
    strTable As String, Optional strWhere As String, _
    Optional strOrderBy As String, Optional strSeparator = ", ") As Variant


    Dim rs As DAO.Recordset
    Dim rsPlace As DAO.Recordset
    Dim strSql As String
    Dim strOut As String
    Dim lngLen As Long
    
    ConcatenateStr = Null
    
    strSql = "SELECT " & strField & ", sum(" & strField1 & ") FROM " & strTable
    If strWhere <> vbNullString Then
        strSql = strSql & " WHERE " & strWhere
    End If
    If strOrderBy <> vbNullString Then
        strSql = strSql & " GROUP BY " & strField & " ORDER BY " & strOrderBy
    End If
    Set rs = DBEngine(0)(0).OpenRecordset(strSql, dbOpenDynaset)
    
    Do While Not rs.EOF
        If Not IsNull(rs(0)) Then
          strOut = strOut & rs(0) & " (" & rs(1) & ")" & strSeparator
        End If
        rs.MoveNext
    Loop
    rs.Close
    
    lngLen = Len(strOut) - Len(strSeparator)
    If lngLen > 0 Then
        ConcatenateStr = Left(strOut, lngLen)
    End If


Exit_Handler:
    Set rsPlace = Nothing
    Set rs = Nothing
    Exit Function


End Function

Trong Query

SELECT sub.MaNV, sub.TenNV, sub.SumOfSoLuong AS Tong, ConcatenateStr("NoiLamViec","SoLuong","nhanvien","[MaNV] = '" & [sub].[MaNV] & "'","NoiLamViec") AS GhiChuFROM [SELECT
q.[MaNV],
q.TenNV,
Sum(q.[SoLuong]) AS SumOfSoLuong
FROM NhanVien AS q
GROUP BY
q.[MaNV],
q.TenNV]. AS sub
ORDER BY sub.MaNV, sub.TenNV;
 

File đính kèm

  • ThuNghiem_2012-08-30.rar
    15.7 KB · Đọc: 56
Trong module:

Mã:
Option Compare Database

Public Function ConcatenateStr(strField As String, strField1 As String, _
    strTable As String, Optional strWhere As String, _
    Optional strOrderBy As String, Optional strSeparator = ", ") As Variant
.............

End Function

Trong Query

Hàm này rất hay, mình cũng thử thêm một cột [Thang] trong CSDL, để lọc thêm theo điều kiện này thì mình phải bắt buộc phải thể hiện trên điều kiện trên cột này, đồng thời cũng phải thể hiện trong điều kiện trong hàm trên luôn.

SELECT MaNV, TenNV, Thang, Sum(SoLuong) AS TongSoLuong, ConcatenateStr("NoiLamViec","SoLuong","NhanVien","Thang='THÁNG 08/ 2012' And [MaNV] = '" & [MaNV] & "'","NoiLamViec") AS GhiChu
FROM NhanVien
WHERE Thang="THÁNG 08/ 2012"
GROUP BY MaNV, TenNV, Thang;

Như vậy lọc mới đúng ý đồ của mình.

Tuy nhiên, có một thắc mắc là mình muốn dùng ADO (câu lệnh từ VBA của Excel) để lọc qua Excel thì phải làm như thế nào với câu lệnh Select?

Mã:
Sub AccToEx()
    On Error Resume Next
    If AccConn = False Then
        MsgBox "Khong ket noi"
    Else
        
        Dim sSQL As String
        Dim adoCommand As Object, oRs As Object
        
        gcnObj.Open
        
[COLOR=#0000cd][B]        sSQL = "SELECT MaNV, TenNV, Sum(SoLuong), " _
             & "ConcatenateStr(NoiLamViec,SoLuong, " _
             & "NhanVien,Thang='THÁNG 08/ 2012' " _
             & "And [MaNV] = '" & [MaNV] & "',NoiLamViec) " _
             & "FROM NhanVien" _
             & "WHERE Thang = 'THÁNG 08/ 2012' " _
             & "GROUP BY MaNV;"[/B][/COLOR]

        Set adoCommand = CreateObject("ADODB.Command")
        
        With adoCommand
            .CommandType = 1
            .ActiveConnection = gcnObj
            .CommandText = sSQL
        End With
        
        Set oRs = CreateObject("ADODB.Recordset")
        oRs.Open adoCommand, , 3, 4
        
        If oRs.EOF Then
            MsgBox "Không có records nào!", vbOKOnly + vbInformation, "THÔNG BÁO"
        Else
            With Sheet1
                .Range("2:65536").ClearContents
                .Range("A2").CopyFromRecordset oRs
            End With
        End If
        
        Set adoCommand = Nothing
        Set oRs = Nothing
        
        If Not gcnObj Is Nothing Then
            If (gcnObj.State And adStateOpen) = adStateOpen Then
                gcnObj.Close
            End If
            Set gcnObj = Nothing
        End If
    End If
End Sub

Xin hướng dẫn giúp mình nhé!
 

File đính kèm

  • Connect.rar
    35.5 KB · Đọc: 42
Hàm này rất hay, mình cũng thử thêm một cột [Thang] trong CSDL, để lọc thêm theo điều kiện này thì mình phải bắt buộc phải thể hiện trên điều kiện trên cột này, đồng thời cũng phải thể hiện trong điều kiện trong hàm trên luôn.

Xin hướng dẫn giúp mình nhé!
Sao kg dùng ADO lấy ra 1 rec và chuyển sang Arr đ6ẻ xử lý, lúc này MaNV đã được sort rồi, kg cân Dic nữa.
PHP:
sSQL = "SELECT MANV, TENNV, Thang, sum(SoLuong) as tongsoluong ,  NoiLamViec as ghichu" & Chr(10)
sSQL = sSQL & "FROM " & sTbl & Chr(10)
sSQL = sSQL & "WHERE Thang = 'THÁNG 08/ 2012'" & Chr(10)
sSQL = sSQL & "Group by MaNV, TENNV, Thang, NoiLamViec"
...
tmpArr = oRs.getrows
 

File đính kèm

  • Nghia_ADO.rar
    32.2 KB · Đọc: 61
Có cách nào mình rút gọn hơn nữa không anh Thunghi. Em nhìn vo thấy arr nhiều quá +-+-+-+
 
Có cách nào mình rút gọn hơn nữa không anh Thunghi. Em nhìn vo thấy arr nhiều quá +-+-+-+

Chắc có lẽ anh ThuNghi kỹ quá nên dùng nhiều vòng lặp như vậy, thật ra khi xử lý mảng theo bài của anh ThuNghi thì không cần phải xử lý đến 2 lần dòng đầu và những dòng sau đâu.
Mã:
Sub AccToEx_2()
    If AccConn = False Then
        MsgBox "Khong ket noi"
        GoTo ErrorHandle
    End If
    
    Dim sSQL As String
    Dim adoCommand As Object, oRs As Object

    gcnObj.Open
    
    sSQL = "SELECT MaNV, TenNV, Thang, SUM(SoLuong) As TongSoLuong, NoiLamViec As DienGiai " _
         & "FROM NhanVien WHERE Thang = 'THÁNG 07/ 2012' " _
         & "GROUP BY MaNV, TenNV, Thang, NoiLamViec;"
    
    Set adoCommand = CreateObject("ADODB.Command")
    
    With adoCommand
        .CommandType = 1
        .ActiveConnection = gcnObj
        .CommandText = sSQL
    End With
    
    Set oRs = CreateObject("ADODB.Recordset")
    oRs.Open adoCommand, , 3, 4
    
    If oRs.EOF Then
        MsgBox "Không có records nào!", vbOKOnly + vbInformation, "THÔNG BÁO"
        GoTo ErrHandle
    End If
    
    Dim AccessArr, AcToExArr, ExcelArr, ArrField()
    Dim c As Long, h As Long, i As Long, j As Long, n As Long, r As Long
    Dim tmp As String: tmp = ""
    
[COLOR=#008000]    ''*****Lay FiledsName -> ArrField:[/COLOR]

    n = oRs.Fields.Count
    ReDim ArrField(1 To n)
    For c = 1 To n
        ArrField(c) = oRs.Fields(c - 1).Name
    Next
   
 [COLOR=#008000]   ''*****Lay Array tu Access:[/COLOR]
    
    AccessArr = oRs.GetRows

    c = UBound(AccessArr, 1) + 1
    h = UBound(AccessArr, 2) + 1

    ReDim AcToExArr(1 To h, 1 To c)
    For i = 1 To h
        For j = 1 To c
            AcToExArr(i, j) = AccessArr(j - 1, i - 1)
        Next
    Next

    [COLOR=#008000]''****Xu ly cong group AcToExArr -> ExcelArr:[/COLOR]

[COLOR=#0000cd] [B]   ReDim ExcelArr(1 To h, 1 To c): r = 0
    For i = 1 To h
        If AcToExArr(i, 1) <> tmp Then
            r = r + 1
            For c = 1 To 4
                ExcelArr(r, c) = AcToExArr(i, c)
            Next
            ExcelArr(r, 5) = AcToExArr(i, 5) & " (" & AcToExArr(i, 4) & ")" [/B][/COLOR][COLOR=#008000][B]''DienGiai[/B][/COLOR][COLOR=#0000cd][B]
        Else
            ExcelArr(r, 4) = ExcelArr(r, 4) + AcToExArr(i, 4) [/B][/COLOR][COLOR=#008000][B]''SoLuong[/B][/COLOR][COLOR=#0000cd][B]
            ExcelArr(r, 5) = ExcelArr(r, 5) & "; " & AcToExArr(i, 5) & " (" & AcToExArr(i, 4) & ")" [/B][/COLOR][COLOR=#008000][B]''DienGiai[/B][/COLOR][COLOR=#0000cd][B]
        End If
        tmp = AcToExArr(i, 1)
    Next[/B]
[/COLOR]
    With Sheets("Report")
        .Cells.ClearContents
        .Range("A1").Resize(, 5) = ArrField
        .Range("A2").Resize(r, 5) = ExcelArr
    End With
    
    Erase AccessArr, AcToExArr, ExcelArr, ArrField()

ErrHandle:
    Set adoCommand = Nothing
    Set oRs = Nothing
    
ErrorHandle:
    If Not gcnObj Is Nothing Then
        If (gcnObj.State And adStateOpen) = adStateOpen Then
            gcnObj.Close
        End If
        Set gcnObj = Nothing
    End If
End Sub

Có lẽ do cơ chế Group của Access nó sort từ A-Z luôn nên mới có thể dùng được với xử lý mảng như vậy. Còn nếu mảng mà chưa sắp xếp thì phải dùng đến Dictionary thôi (tôi thiết nghĩ nên dùng thì tốt hơn):

Thay thủ tục màu xanh thành thủ tục dưới đây:

Mã:
    [COLOR=#008000]''****Xu ly cong group AcToExArr -> ExcelArr:[/COLOR]
    
    ReDim ExcelArr(1 To h, 1 To c): r = 0
    With CreateObject("Scripting.Dictionary")
        For i = 1 To h
            tmp = AcToExArr(i, 1)
            If Not .Exists(tmp) Then
                r = r + 1: .Add tmp, r
                For c = 1 To 4
                    ExcelArr(r, c) = AcToExArr(i, c)
                Next
                ExcelArr(r, 5) = AcToExArr(i, 5) & " (" & AcToExArr(i, 4) & ")" [COLOR=#008000]''DienGiai[/COLOR]
            Else
                ExcelArr(.Item(tmp), 4) = ExcelArr(.Item(tmp), 4) + AcToExArr(i, 4) [COLOR=#008000]''SoLuong[/COLOR]
                ExcelArr(.Item(tmp), 5) = ExcelArr(.Item(tmp), 5) & "; " & AcToExArr(i, 5) & " (" & AcToExArr(i, 4) & ")" [COLOR=#008000]''DienGiai[/COLOR]
            End If
        Next
    End With
 
Lần chỉnh sửa cuối:
Chắc có lẽ anh ThuNghi kỹ quá nên dùng nhiều vòng lặp như vậy, thật ra khi xử lý mảng theo bài của anh ThuNghi thì không cần phải xử lý đến 2 lần dòng đầu và những dòng sau đâu.

Lý do là tôi muốn đưa ra những tình huống
1/ Chuyển từ Rec sang TmpArr
2/ Chuyển TmpArr sang sArr (ngang sang dọc) cho dễ nhìn
3/ Xử lý sArr
3 công đoạn này thì có thể làm thẳng từ Rec sang kq luôn nhưng thấy thêm công đoạn kg ảnh hưởng lắm và nhất là dễ nhìn và xử lý theo hướng Arr.

Còn đã dùng ADO thì dùng thêm Dic thì hơi dư, phần sort thì chắc chắn sẽ sort theo cột 1, TH muốn sort thêm thì chỉ cần thêm "Order by ..." vào câu SQL là OK.
 
Lý do là tôi muốn đưa ra những tình huống
1/ Chuyển từ Rec sang TmpArr
2/ Chuyển TmpArr sang sArr (ngang sang dọc) cho dễ nhìn
3/ Xử lý sArr
3 công đoạn này thì có thể làm thẳng từ Rec sang kq luôn nhưng thấy thêm công đoạn kg ảnh hưởng lắm và nhất là dễ nhìn và xử lý theo hướng Arr.

Còn đã dùng ADO thì dùng thêm Dic thì hơi dư, phần sort thì chắc chắn sẽ sort theo cột 1, TH muốn sort thêm thì chỉ cần thêm "Order by ..." vào câu SQL là OK.



Anh ThuNghi nói đúng đó, mình chỉ cần xử lý thẳng luôn một lần cho gọn!

Thay vì xử lý nhiều lần:

PHP:
    AccessArr = oRs.GetRows

    c = UBound(AccessArr, 1) + 1
    h = UBound(AccessArr, 2) + 1

    ReDim AcToExArr(1 To h, 1 To c)
    For i = 1 To h
        For j = 1 To c
            AcToExArr(i, j) = AccessArr(j - 1, i - 1)
        Next
    Next

    ''****Xu ly cong group AcToExArr -> ExcelArr:

    ReDim ExcelArr(1 To h, 1 To c): r = 0
    For i = 1 To h
        If AcToExArr(i, 1) <> tmp Then
            r = r + 1
            For c = 1 To 4
                ExcelArr(r, c) = AcToExArr(i, c)
            Next
            ExcelArr(r, 5) = AcToExArr(i, 5) & " (" & AcToExArr(i, 4) & ")"      ''DienGiai
        Else
            ExcelArr(r, 4) = ExcelArr(r, 4) + AcToExArr(i, 4)          ''SoLuong
            ExcelArr(r, 5) = ExcelArr(r, 5) & "; " & AcToExArr(i, 5) & " (" & AcToExArr(i, 4) & ")"         ''DienGiai
        End If
        tmp = AcToExArr(i, 1)
    Next

Thì mình xử lý ngay sau khi mảng "mới ra lò" luôn:

PHP:
    AccessArr = oRs.GetRows

    c = UBound(AccessArr, 1) + 1
    h = UBound(AccessArr, 2) + 1

    ReDim ExcelArr(1 To h, 1 To c): r = 0
    For i = 1 To h
        If AccessArr(0, i - 1) <> tmp Then
            r = r + 1
            For j = 1 To 4
                ExcelArr(r, j) = AccessArr(j - 1, i - 1)
            Next
            ExcelArr(r, 5) = AccessArr(4, i - 1) & " (" & AccessArr(3, i - 1) & ")"            ''DienGiai
        Else
            ExcelArr(r, 4) = ExcelArr(r, 4) + AccessArr(3, i - 1)            ''SoLuong
            ExcelArr(r, 5) = ExcelArr(r, 5) & "; " & AccessArr(4, i - 1) & " (" & AccessArr(3, i - 1) & ")"         ''DienGiai
        End If
        tmp = AccessArr(0, i - 1)
    Next

Như vậy đỡ tốn một vài công đoạn nữa và đương nhiên thời gian có thể nhỉn hơn tí xíu.
 
Sẳn đề tài này cho mình hỏi là câu lệnh SQL với WHERE với điều điện trường đó = rổng thì phải đặt câu lệnh gì? (nghĩa là trường đó chưa nhập gì vào hết).
Xin cám ơn!
 
Điều kiện vậy thì là
Cám ơn anh! Nhưng sao ra, khi bỏ điều kiện đó thì nó ra (Câu lệnh không báo lỗi nhưng không xuất ra dử liệu)
Câu lệnh điều kiện đó như bên dưới anh xem giúp có sai gì k nhé. Cám ơn anh.

mySql = mySql & "WHERE (MK=" & Kh & ")And(TKC='1111')AND(MN='" & MNg & "')AND(MNKP=" & NgKP & ")And(NHT>=" & Date1 & ")and(NHT<=" & Date2 & ")and(TM>0) and (NTT IS NULL) order by TM;"
 
Cám ơn anh! Nhưng sao ra, khi bỏ điều kiện đó thì nó ra (Câu lệnh không báo lỗi nhưng không xuất ra dử liệu)
Câu lệnh điều kiện đó như bên dưới anh xem giúp có sai gì k nhé. Cám ơn anh.

mySql = mySql & "WHERE (MK=" & Kh & ")And(TKC='1111')AND(MN='" & MNg & "')AND(MNKP=" & NgKP & ")And(NHT>=" & Date1 & ")and(NHT<=" & Date2 & ")and(TM>0) and (NTT IS NULL) order by TM;"
Phải xem dữ liệu mới xác định cái trường nào là kiểu text trường nào là số, đặc biệt là ngày tháng mà có cách xử khác nhau.
 
Mình có một file dữ liệu là access, trong có 3 table: tblBan, tblHang, tblKho. Mình muốn hỏi mọi người câu SQL để có kết quả hiển thị như trong bảng "Ket qua" ở trong file gửi kèm. Viết bằng VBA để hiển thị bảng "Ket qua" trong excel nhé, rất mong đượcmọi người giúp đỡ!
 

File đính kèm

  • Vi du.xlsx
    10.6 KB · Đọc: 10
Mình có một file dữ liệu là access, trong có 3 table: tblBan, tblHang, tblKho. Mình muốn hỏi mọi người câu SQL để có kết quả hiển thị như trong bảng "Ket qua" ở trong file gửi kèm. Viết bằng VBA để hiển thị bảng "Ket qua" trong excel nhé, rất mong đượcmọi người giúp đỡ!

Bạn tạo CSDL Access 2003 và chuyển đổi file excel trên sang 2003 giúp nhé.
 
Gửi bạn. Nhờ bạn giúp nhé!
Đầu tiên bạn chỉnh kiểu dữ liệu của trường BMaHang của bảng tblBan về kiểu number cho giống với HMaHang của bảng tblHang, và chỉnh KMaKhoLuuTru của bảng tblKho về làm khóa chính.

Code trong Excel để lấy dữ liệu theo yêu cầu của bạn là:

Mã:
Option Explicit
Sub LayDL()
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim lsSQL As String
With cnn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\data.mdb"
    .CursorLocation = adUseClient
    .Open

End With

    lsSQL = "SELECT tblBan.BNgay, tblBan.BMaHang, tblHang.HTenhang, tblBan.BMaKhoLuuTru, tblKho.KTenKhoLuuTru, tblBan.BSoLuongBan " & _
                    "FROM tblKho INNER JOIN (tblHang INNER JOIN tblBan ON tblHang.HMaHang = tblBan.BMaHang) ON tblKho.KMaKhoLuuTru = tblBan.BMaKhoLuuTru;"

    rst.Open lsSQL, cnn, 1, 3
    [b5:g6000].ClearContents
    [b5].CopyFromRecordset rst
    
rst.Close: Set rst = Nothing
cnn.Close: Set cnn = Nothing

End Sub

Bạn xem file đính kèm nhé

Lưu ý: Giải nén rồi mới chạy file Excel nhé.
 

File đính kèm

  • KetNoi.rar
    25.3 KB · Đọc: 56
Lần chỉnh sửa cuối:
Phải xem dữ liệu mới xác định cái trường nào là kiểu text trường nào là số, đặc biệt là ngày tháng mà có cách xử khác nhau.
Cám ơn anh. Anh cho em hỏi có câu điều kiện nào đại diện cho tất cả các kiểu dử liệu của trường đó k? (có nghĩa là trường đó là rổng hoặc bất cứ kiểu dử liệu gì nó cũng cho ra hết)
 
Cám ơn anh. Anh cho em hỏi có câu điều kiện nào đại diện cho tất cả các kiểu dử liệu của trường đó k? (có nghĩa là trường đó là rổng hoặc bất cứ kiểu dử liệu gì nó cũng cho ra hết)

Thì không cần gắn điều kiện gì vào trường đó hết. Như vậy nó sẽ hiện hết dữ liệu.
 
Thì không cần gắn điều kiện gì vào trường đó hết. Như vậy nó sẽ hiện hết dữ liệu.
Tại vì có lúc có lúc không? áp dụng cho nhiều trường hợp, trường đó có thể có hoặc không có dử liệu. nên em mới cần điều kiện như vậy. Em muốn điều kiện lọc giống như lọc bằng Advalced Filter vậy đấy, bổ tróng thì lộc hết, có điều kiện thì lọc theo điều kiện. Cám ơn anh đã quan tâm.
 
Tại vì có lúc có lúc không? áp dụng cho nhiều trường hợp, trường đó có thể có hoặc không có dử liệu. nên em mới cần điều kiện như vậy. Em muốn điều kiện lọc giống như lọc bằng Advalced Filter vậy đấy, bổ tróng thì lộc hết, có điều kiện thì lọc theo điều kiện. Cám ơn anh đã quan tâm.

Muốn áp dụng theo ý muốn có lúc vầy lúc khác thì bạn phải tạo 1 biến hoặc cái gì đó làm điều kiện để lọc. Nói chung tùy biến mà áp dụng vào thực tế.
 
Web KT
Back
Top Bottom