Nhờ sửa code tính tổng khi gộp dữ liệu bằng ADO

[nguyenkar]

Mình cần anh chị em giúp đỡ sửa đoạn code trong file tổng kết (code này mót từ Mr.DBA) hoặc viết giúp đoạn code mới giống vậy, để có thể vừa gom được dữ liệu từ các file con (chọn được file nào muốn gom dữ liệu), vừa tính tổng điểm của những người trùng như trong sheet tên PowerQuery. Rất cảm ơn anh chị giúp đỡ ạ.

 

[Hai Lúa Miền Tây]

Vậy theo em hiểu là, sau khi mở kết nối thì sẽ truy vấn lần 1 để lấy dữ liệu, sau đó sẽ tiếp tục truy vấn để sum và group vào cái dữ liệu đã lấy ( câu .Execute sẽ chạy trước) rồi mới CopyFromRecordset ra sheet đúng không ạ?

Mới bắt đầu làm quen thì bạn tạm hiểu như thế này nhé. Sau này làm quen rồi thì bạn tự nhận ra thôi.

 

[nguyenkar]

strSQL = strSQL & " Union All Select [Code],[Name],[Group],[SubTotal] From [EXCEL 12.0;Database=" & strPath & "].[TongKet$] Where [Name] Is Not Null"

Admin cho em hỏi, nếu em muốn sửa theo cột (nếu tiêu đề cột để tiếng Việt có dấu, thì không lấy theo tiêu đề được ạ), và xác đinh range thì sẽ phải sửa thế nào ạ. Em làm thử nhưng không được ạ, em mò trong debug local thì không định vị được dữ liệu truy vấn nằm chỗ nào hết.

strSQL = strSQL & " Union All Select f1,f2 From [EXCEL 12.0;Database=" & strPath & "].[TongKet$M3:N1000] Where f1 Is Not Null"
'và câu
Sheets("baocao").Range("F5").CopyFromRecordset .Execute("Select f1, Sum(f2) From (" & Right(strSQL, Len(strSQL) - 10) & ") Group By f1, f2")

 

[Hai Lúa Miền Tây]

strSQL = strSQL & " Union All Select [Code],[Name],[Group],[SubTotal] From [EXCEL 12.0;Database=" & strPath & "].[TongKet$] Where [Name] Is Not Null"

Admin cho em hỏi, nếu em muốn sửa theo cột (nếu tiêu đề cột để tiếng Việt có dấu, thì không lấy theo tiêu đề được ạ), và xác đinh range thì sẽ phải sửa thế nào ạ. Em làm thử nhưng không được ạ, em mò trong debug local thì không định vị được dữ liệu truy vấn nằm chỗ nào hết.

strSQL = strSQL & " Union All Select f1,f2 From [EXCEL 12.0;Database=" & strPath & "].[TongKet$M3:N1000] Where f1 Is Not Null"
'và câu
Sheets("baocao").Range("F5").CopyFromRecordset .Execute("Select f1, Sum(f2) From (" & Right(strSQL, Len(strSQL) - 10) & ") Group By f1, f2")

Tiêu đề = Tiếng Việt? Bạn có thể gõ trong cửa sổ VBA Editor thì được. Hoặc có thể tham chiếu đến 1 name, vùng trên sheet. Nhưng phải thêm 2 dấu [] bao quanh tên cột.
Bạn thêm thuộc tính HDR=No vào chuỗi kết nối thử nhé.

 

[nguyenkar]

Tiêu đề = Tiếng Việt? Bạn có thể gõ trong cửa sổ VBA Editor thì được. Hoặc có thể tham chiếu đến 1 name, vùng trên sheet. Nhưng phải thêm 2 dấu [] bao quanh tên cột.
Bạn thêm thuộc tính HDR=No vào chuỗi kết nối thử nhé.

Em thử các câu lệnh như sau:
Đầu tiên thử thêm HDR=No vào thì nhận được thông báo lỗi như hình 1, khi thay đổi thành Excel 8.0 vẫn bị y chang (Microsoft.Jet.OLEDB.4.0)
Sau đó e lại bỏ HDR đi và sửa các cột tham chiếu như code thì bị lỗi như hình 2 ạ. Do bảng debug local em dò không thấy được kết quả đã tham chiếu được nên ko biết cách xử lý trong From thế nào

strSQL = strSQL & " Union All Select [M3] as [Name],[N3] as [SubTotal] From [EXCEL 12.0;Database=" & strPath & "].[TongKet$M3:N1000] Where [Name] Is Not Null"

sh.Range("F5").CopyFromRecordset .Execute("Select [Name], Sum(SubTotal) From (" & Right(strSQL, Len(strSQL) - 10) & ") Group By Name")

Còn việc gõ tiếng Việt không dấu trực tiếp vào vba thì chắc em thua từ đầu, em gõ vào hỏng luôn mấy dấu ngoặc đơn ngoặc kép...
Vd như "Tên học viên" em gõ : ["Tên H" & ChrW(7885) & "c Viên"] và Tổng điểm cá nhân: ["T" & ChrW(7893) & "ng " & ChrW(273) & "i" & ChrW(7875) & "m cá nhân"], chương trình báo lỗi dấu "" chẳng biết đâu mà lần.

 

[nguyenkar]

Bạn thử code sửa lại như sau nhé:

Sub TongHop_HLMT()
    Dim strPath As Variant, strSQL As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Excel Files", "*.xls*", 1
        If Not .Show = -1 Then
            MsgBox "Ban da khong chon tong hop", vbInformation, "Thông Báo"
            Exit Sub
        End If
        For Each strPath In .SelectedItems
            strSQL = strSQL & " Union All Select [Code],[Name],[Group],[SubTotal] From [EXCEL 12.0;Database=" & strPath & "].[TongKet$] Where [Name] Is Not Null"
        Next
    End With
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0 Xml;"
        Sheet5.Range("E2").CopyFromRecordset .Execute("Select [Code],[Name],[Group],Sum(SubTotal) From (" & Right(strSQL, Len(strSQL) - 10) & ") Group By [Code],[Name],[Group]")
    End With
 
End Sub

Với em hỏi thêm vấn đề này nữa, trong sub trên em ko tìm thấy dòng lệnh ngắt kết nối, nếu vậy có phải sau khi thực thi hết thì connection tự ngắt hay vẫn để treo đó?