(Mở file này so sánh file kia và ngược lại)
- Chép code sau vào module của 2 file
Code:
Sub GetWorksheetData(strSourceFile As String, strSQL As String, TargetCell As Range)
Dim cn As ADODB.Connection, rs As ADODB.Recordset, f As Integer, r As Long
If TargetCell Is Nothing Then Exit Sub
Set cn = New ADODB.Connection
On Error Resume Next
cn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DriverId=790;ReadOnly=True;" & _
"DBQ=" & strSourceFile & ";"
On Error GoTo 0
If cn Is Nothing Then
MsgBox "Can't find the file!", vbExclamation, ThisWorkbook.Name
Exit Sub
End If
Set rs = New ADODB.Recordset
On Error Resume Next
rs.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
On Error GoTo 0
If rs Is Nothing Then
MsgBox "Can't open the file!", vbExclamation, ThisWorkbook.Name
cn.Close
Set cn = Nothing
Exit Sub
End If
TargetCell.CopyFromRecordset rs
If rs.State = adStateOpen Then
rs.Close
End If
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Code:
Sub LookUpValue()
Dim MyPath As String, FName As Variant, rng As Range
MyPath = Application.DefaultFilePath
FName = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*")
If FName = False Then
Exit Sub
Else
MyPath = FName
Application.ScreenUpdating = False
For Each rng In Range("C2:C" & Range("C60000").End(xlUp).Row)
If Len(rng) > 0 Then
With rng
.Offset(, 3) = ""
GetWorksheetData MyPath, "SELECT 'Da co' as SP FROM [Sheet1$] where MASP like '" & .Value & "';", .Offset(, 3)
If Len(rng) > 0 And Len(rng.Offset(, 3)) = 0 Then rng.Offset(, 3) = "Chua co"
End With
End If
Next
Application.ScreenUpdating = True
End If
End Sub
Code:
Sub LookUpValue()
Dim MyPath As String, FName As Variant, rng As Range
MyPath = Application.DefaultFilePath
FName = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*")
If FName = False Then
Exit Sub
Else
MyPath = FName
Application.ScreenUpdating = False
For Each rng In Range("e2:e" & Range("E60000").End(xlUp).Row)
If Len(rng) > 0 Then
With rng
.Offset(, 8) = ""
GetWorksheetData MyPath, "SELECT 'Da co' as SP FROM [NhapTay$] where MASP like '" & .Value & "';", .Offset(, 8)
If Len(rng) > 0 And Len(rng.Offset(, 8)) = 0 Then rng.Offset(, 8) = "Chua co"
End With
End If
Next
Application.ScreenUpdating = True
End If
End Sub
Bạn xem file nhé.
(Lưu ý nhớ giải nén rồi mở file nhé.)
ADO.rar (25.8 KB)
0 nhận xét:
|» Đăng hình ảnh | code chèn sẽ là [img] Link ảnh [/img]
|» Đăng nhạc của tui | code sẽ là [nct] Link bài hát [/nct]
|» Đăng Video Youtube | code sẽ là [youtube] Link Video Youtube [/youtube]
|» <b> Chữ in đậm <\/b>
|» <i> Chữ in nghiêng <\/i>