Với đoạn code của bạn Hai Lúa thì hôm nay mình dùng khá ổn. có điều mình chuyển bảng thống kê của mình sang add-ins để dùng nên mỗi lần tạo 1 bảng thống kê mới lại phải lưu mới chạy được nên hơi bất tiện.
Nên mình lại tiếp tục lên topic này để nhờ các bạn nào có thể giúp hiệu chỉnh lại đoạn code tổng hợp thép ở #5 sao cho khi chạy code thì sẽ hiện thông báo "Để đảm bảo an toàn, Bạn nên lưu bảng thống kê trước khi tiếp tục công việc" và tiến hành save lại. công tác save chỉ 1 lần đầu thôi, lần tạo bảng thống kê mới tiếp theo nếu kiểm tra save rồi thì thôi, nếu chưa save thì lại hiện thông báo như lúc ban đầu.
- Nếu bạn nào có thể giúp mình mà lại chuyên bên mảng VBA hơn thì nhờ giúp mình đoạn code VBA với nội dung như đoạn code ADO ở bài #5 với. (Vì nghe bạn Hai Lúa nói nếu dùng VBA thì sẽ bỏ qua đc bước save)
Mình cảm ơn!
Kiểm tra nếu file chưa được lưu vào ổ đĩa thì lưu vào ổ C với tên tương ứng của WB đó, ngược lại sẽ lưu file rồi mới chạy code.
[GPECODE=sql]Sub ModTongHopThepHinh()
On Error Resume Next
Dim adoConn As Object, adoRS As Object, fld, i As Integer, eR As Integer
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
If InStr(ActiveWorkbook.FullName, ":\") = 0 Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "C:\" & ActiveWorkbook.Name
Else
ActiveWorkbook.Save
Application.DisplayAlerts = True
End If
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select CK,CLT,QCT,sum(CD) as [TCD],sum(TL) as [TTL],sum(DTS) as [TDTS] " _
& "from [" & ActiveSheet.Name & "$A10:R500] " _
& "group by CK,CLT,QCT " _
& "having CK is not null"
End With
With ActiveSheet
.Range("U11:AF500").ClearContents
For Each fld In adoRS.Fields
i = i + 1
.Cells(10, i + 20) = fld.Name
Next
.[U11].CopyFromRecordset adoRS
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select '' as STT,CLT,QCT,sum(CD) as [TCD],sum(TL) as [TTL] " _
& "from [" & ActiveSheet.Name & "$A10:R500] " _
& "group by CLT,QCT " _
& "having CLT is not null " _
& "order by right(QCT,1),CLT"
End With
i = 0
With ActiveSheet
For Each fld In adoRS.Fields
i = i + 1
.Cells(10, i + 27) = fld.Name
Next
.[AB11].CopyFromRecordset adoRS
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select sum(DTS) as [TDTS] " _
& "from [" & ActiveSheet.Name & "$A10:R500]"
End With
With ActiveSheet
eR = .Range("AC65000").End(xlUp).Row + 1
.Range("AC" & eR) = "T" & ChrW(7892) & "NG C" & ChrW(7896) & "NG"
.Range("AC" & eR + 1) = "T" & ChrW(7892) & "NG DI" & ChrW(7878) & "N TÍCH S" & ChrW(416) & "N"
.Range("AE" & eR).FormulaR1C1 = "=SUM(R[-" & eR - 11 & "]C:R[-1]C)"
.Range("AF" & eR).FormulaR1C1 = "=SUM(R[-" & eR - 11 & "]C:R[-1]C)"
.Range("AE" & eR + 1).CopyFromRecordset adoRS
' .Cells.EntireColumn.AutoFit
.Range("AB11:AB" & eR - 1).FormulaR1C1 = "=ROW()-10"
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing
End Sub
[/GPECODE]
Em làm theo cách này mà ko được bác ạ
bác có yahoo ko ạ
Bạn làm như thế nào mà không được?
