(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>