Lúc đầu e thử copy thêm đoạn code từ [TDTS] xuống bên dưới và thay bằng [TQH] thì chạy ko được. hóa ra phải thêm "adoRS.Close" ở trước thì mới được hả a?
a có thể giúp e hiểu hơn cái đoạn "adoRS.Close" có tác dụng gì ko a? e chỉ biết là nó đóng thôi
E có file đính kèm nhờ a xem giúp e.
Cảm ơn a!
Bạn test thử code sau:
[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 "F:\" & 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(QH) as [TQH],sum(DTS) as [TDTS] " _
& "from [" & ActiveSheet.Name & "$A10:S500] " _
& "group by CK,CLT,QCT " _
& "having CK is not null"
End With
With ActiveSheet
.Range("V11:AH500").UnMerge
.Range("V11:AH500").Delete xlUp
For Each fld In adoRS.Fields
i = i + 1
.Cells(10, i + 21) = fld.Name
Next
.[V11].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:S500] " _
& "group by CLT,QCT " _
& "having CLT is not null " _
& "order by left(CLT,1),CLT,right(QCT,1),right(QCT,2),right(QCT,3)"
End With
If adoRS.EOF Then
MsgBox "Khong co du lieu o BTK, vui long kiem tra lai", vbCritical
ActiveWorkbook.Close (True)
End If
i = 0
With ActiveSheet
For Each fld In adoRS.Fields
i = i + 1
.Cells(10, i + 29) = fld.Name
Next
.[AD11].CopyFromRecordset adoRS
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select CLT,sum(TL) as [TKLCL] " _
& "from [" & ActiveSheet.Name & "$A10:S500] " _
& "group by CLT " _
& "having CLT is not null " _
& "order by left(CLT,1)"
End With
i = 0
With ActiveSheet
For Each fld In adoRS.Fields
i = i + 1
.Cells(10, i + 36) = fld.Name
Next
.[AK11].CopyFromRecordset adoRS
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select sum(DTS) as [TDTS] " _
& "from [" & ActiveSheet.Name & "$A10:S500]"
End With
With ActiveSheet
eR = .Range("AE65000").End(xlUp).Row + 1
.Range("AE" & eR) = "T" & ChrW(7892) & "NG C" & ChrW(7896) & "NG"
.Range("AE" & eR + 1) = "T" & ChrW(7892) & "NG DI" & ChrW(7878) & "N TÍCH S" & ChrW(416) & "N (m2)"
.Range("AE" & eR + 2) = "T" & ChrW(7892) & "NG K. L" & ChrW(431) & ChrW(7906) & "NG QUE HÀN (kg)"
.Range("AG" & eR).FormulaR1C1 = "=SUM(R[-" & eR - 11 & "]C:R[-1]C)"
.Range("AH" & eR).FormulaR1C1 = "=SUM(R[-" & eR - 11 & "]C:R[-1]C)"
.Range("AG" & eR + 1).CopyFromRecordset adoRS
' .Cells.EntireColumn.AutoFit
.Range("AD11:AD" & eR - 1).FormulaR1C1 = "=ROW()-10"
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select sum(QH) as [TQH] " _
& "from [" & ActiveSheet.Name & "$A10:S500]"
End With
.Range("AH" & eR + 2).CopyFromRecordset adoRS
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing
End Sub
[/GPECODE]
a có thể giúp e hiểu hơn cái đoạn "adoRS.Close" có tác dụng gì ko a? e chỉ biết là nó đóng thôi
Cảm ơn a!
Khi thực hiện mở 1 adoRS xong ta phải đóng nó lại rồi mới tiếp tục mở thêm cái mới.
