Xin chào các Anh/Chị trong diễn đàn GPE,
Em đang tập tành học ADO để phục vụ cho công việc, em có nhờ Chat GPT tạo code nhưng khi áp dụng vào thì bị lỗi.
Nếu trường dữ liệu ở sheet "TT35" là A3: D57198 và sheet2 là D3:H58579 thì code chạy ngon,
nhưng nếu mở rộng dữ liệu, tăng số lượng dòng lên, cụ thể là sheet "TT35" lên A3: D657198 và sheet2 là D3:H658579 thì code báo lỗi khi mở recordset như hình đính kèm.
Do ở công ty không cho phép tải file lên, nên nếu cần file mẫu thì tối về em sẽ giả lập đính kèm lên ạ.
Nhờ Anh/ Chị GPE xem sửa lỗi giúp em với.
Em xin cảm ơn.
Em đang tập tành học ADO để phục vụ cho công việc, em có nhờ Chat GPT tạo code nhưng khi áp dụng vào thì bị lỗi.
Nếu trường dữ liệu ở sheet "TT35" là A3: D57198 và sheet2 là D3:H58579 thì code chạy ngon,
nhưng nếu mở rộng dữ liệu, tăng số lượng dòng lên, cụ thể là sheet "TT35" lên A3: D657198 và sheet2 là D3:H658579 thì code báo lỗi khi mở recordset như hình đính kèm.
Do ở công ty không cho phép tải file lên, nên nếu cần file mẫu thì tối về em sẽ giả lập đính kèm lên ạ.
Nhờ Anh/ Chị GPE xem sửa lỗi giúp em với.
Em xin cảm ơn.
Mã:
Sub CompareAmounts()
Dim conn As Object
Dim rs As Object
Dim sql As String
Dim ws As Worksheet
Dim lastRow As Long
' Tao ket noi ADO
Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
conn.Open
If Err.Number <> 0 Then
MsgBox "Loi khi mat ket noi: " & Err.Description
Exit Sub
End If
On Error GoTo 0
' Truy van SQL de so sanh amount_fcy tu hai sheet
sql = "SELECT TT35.contract_no, TT35.amount_fcy AS Amount_TT35, Sheet2.AMOUNT_FCY AS Amount_Sheet2 " & _
"FROM [TT35$A3:D657198] AS TT35 " & _
"LEFT JOIN [Sheet2$D3:H658579] AS Sheet2 " & _
"ON TT35.contract_no = Sheet2.CONTRACT_NO"
' Mo recordset
Set rs = CreateObject("ADODB.Recordset")
On Error Resume Next
rs.Open sql, conn, 1, 1
If Err.Number <> 0 Then
MsgBox "Loi khi mo recordset: " & Err.Description
---dang bi loi o day a**
conn.Close
Set conn = Nothing
Exit Sub
End If
On Error GoTo 0
' Tao bang ket qua tren mot sheet moi
On Error Resume Next
Set ws = ThisWorkbook.Sheets("Comparison")
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Sheets.Add
ws.Name = "Comparison"
End If
' Dat Tieu de cho bang ket qua
ws.Cells(1, 1).Value = "contract_no"
ws.Cells(1, 2).Value = "Amount_TT35"
ws.Cells(1, 3).Value = "Amount_Sheet2"
' Dien du lieu tu recordset vào bang
lastRow = 2
Do While Not rs.EOF
ws.Cells(lastRow, 1).Value = rs.Fields("contract_no").Value
ws.Cells(lastRow, 2).Value = rs.Fields("Amount_TT35").Value
ws.Cells(lastRow, 3).Value = rs.Fields("Amount_Sheet2").Value
rs.MoveNext
lastRow = lastRow + 1
Loop
' Dong ket noi và recordset
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub
