Lấy Dữ Liệu Mà Không mở file nguồn (1 người xem)

Let'GâuGâu · 30/10/13

chào anh chi, tôi có 2 file cùng một thư mục

ở file đích, tôi muốn cập nhật vào cột C dựa vào mã sản phẩm ở cột B (file nguồn mã sản phẩm cột B,trả về giá trị cột V).

có cách nào cập nhật giá trị này mà không cần mở file nguồn

cám ơn mọi người giúp đỡ

ndu96081631 · 30/10/13

Let'GâuGâu đã viết:
Cảm ơn bạn, ADO không àh, muốt không trôi, biến tấu không được, nhờ các sự phụ viết rồi từ từ "ngâm"

Thật ra cũng chẳng cần phải hiểu, biết áp dụng là được
Trước tôi có viết ở đây:
http://www.giaiphapexcel.com/forum/showthread.php?86477-Import-dữ-liệu&p=540333#post540333
Bạn cứ lấy code về chạy và nghiên cứu. Lấy dữ liệu từ file nguồn, Sheet 28, vùng B9:V1000 chẳng hạn. Sau khi có trong tay mảng kết quả, xử lý gì tiếp tùy bạn

Quang_Hải · 30/10/13

Let'GâuGâu đã viết:
chào anh chi, tôi có 2 file cùng một thư mục

ở file đích, tôi muốn cập nhật vào cột C dựa vào mã sản phẩm ở cột B (file nguồn mã sản phẩm cột B,trả về giá trị cột V).

có cách nào cập nhật giá trị này mà không cần mở file nguồn

cám ơn mọi người giúp đỡ

Mình chắp vá code của các anh chị trên diễn đàn để cho ra code này. Mình chỉ lấy dữ liệu ra tới mảng Arr, sau đó bạn thích làm gì với nó thì là tiếp vì bạn cũng biết VBA

PHP:

Sub ADO()
    Dim CON As Object, REC As Object, FileName As String, StrRequest As String, Arr()
    Set CON = CreateObject("ADODB.Connection")
    Set REC = CreateObject("ADODB.Recordset")
    FileName = ThisWorkbook.Path & "\NGUON.xls"
    With CON
        If Application.Version < 12 Then
             .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";Extended Properties=""Excel 8.0;HDR=no;"";"
        Else
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";Extended Properties=""Excel 12.0;HDR=no;"";"
        End If
        .Open
    End With
StrRequest = "SELECT * FROM [29$B9:V10000]"
REC.Open StrRequest, CON
Arr = REC.GetRows
Arr = TransArr(Arr)
'tới đây rồi bạn có thể lấy dữ liệu dễ dàng rồi
End Sub
'..................................................................
Function TransArr(Sarr As Variant) As Variant
    Dim cllX As Long, cllY As Long, tmpX As Long, tmpY As Long, tmpArr As Variant
    tmpX = UBound(Sarr, 2)
    tmpY = UBound(Sarr, 1)
    ReDim tmpArr(tmpX, tmpY)
    For cllX = 0 To tmpX
        For cllY = 0 To tmpY
            tmpArr(cllX, cllY) = Sarr(cllY, cllX)
        Next cllY
    Next cllX
    TransArr = tmpArr
End Function

Quang_Hải · 31/10/13

Nhân tiện cùng ngắm nhìn cái mảng ngược khi ta dùng phương thức GetRows để lấy dữ liệu
Nếu không dùng hàm đảo mảng thì phải xử lý thế này cho file của bạn

Mã:

Sub ADO()
    Dim CON As Object, REC As Object, Arr
    Dim FileName As String, StrRequest As String, temp1(), temp2(1 To 10000, 1 To 2)
    Dim i As Long, k As Long
    Set CON = CreateObject("ADODB.Connection")
    Set REC = CreateObject("ADODB.Recordset")
    FileName = ThisWorkbook.Path & "\NGUON.xls"
    With CON
        If Application.Version < 12 Then
             .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
            & " Data Source=" & FileName & ";Extended Properties=""Excel 8.0;HDR=no;"";"
        Else
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & FileName & ";Extended Properties=""Excel 12.0;HDR=no;"";"
        End If
        .Open
    End With
StrRequest = "SELECT * FROM  [29$B9:V10000]"
REC.Open StrRequest, CON
Arr = REC.GetRows
temp1 = Range([B13], [b65536].End(3)).Value
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(temp1)
      If temp1(i, 1) <> "" Then
         If Not .exists(temp1(i, 1)) Then
            k = k + 1
            .Add temp1(i, 1), k
            temp2(k, 1) = temp1(i, 1)
         End If
      End If
   Next
   For i = [COLOR=#ff0000]0[/COLOR] To UBound(Arr, 2)
      If Arr(LBound(Arr, 1), i) <> "" Then
         If .exists(Arr(LBound(Arr), i)) Then
            temp2(.item(Arr(LBound(Arr), i)), 2) = Arr(UBound(Arr), i)
         End If
      End If
   Next
End With
[B13].Resize(k, 2) = temp2

End Sub

Cái mảng ngược này quả là ngược thật. Nhức cái đầu.

Let'GâuGâu · 31/10/13

quanghai1969 đã viết:
Nhân tiện cùng ngắm nhìn cái mảng ngược khi ta dùng phương thức GetRows để lấy dữ liệu
Nếu không dùng hàm đảo mảng thì phải xử lý thế này cho file của bạn

Cái mảng ngược này quả là ngược thật. Nhức cái đầu.

cám ơn anh Quang Hai.
code chạy rất tuyệt vời....
được voi thì đòi tiên đẹp thêm chút nữa nha anh,
Do file nguồn và sheet là biến, chứ không cố định

nó là như vậy: cell B13: tôi có mã là 102910,
như vậy nó sẻ mở file số 10 (trong thư mục này có 12 file tương ứng với 12 tháng)
sheet29(có 30 hoặc 31 sheet, tuy theo số ngày trong tháng)
vào cuộn số 10 (dòng thứ 18) để lấy số liệu

với lại tôi muốn sử dụng sự kiện, vi dụ như khi gõ 102910 vào Cell B13 xong thì nó xuất kết quả ra C13
code phức tạp quá nên không biết phải chỉnh như thế nào để được theo ý mình,
chừng nào anh rảnh và có hứng thì xem thử giúp nha
cám ơn anh nhiều

Quang_Hải · 31/10/13

Let'GâuGâu đã viết:
cám ơn anh Quang Hai.
code chạy rất tuyệt vời....
được voi thì đòi tiên đẹp thêm chút nữa nha anh,
Do file nguồn và sheet là biến, chứ không cố định

nó là như vậy: cell B13: tôi có mã là 102910,
như vậy nó sẻ mở file số 10 (trong thư mục này có 12 file tương ứng với 12 tháng)
sheet29(có 30 hoặc 31 sheet, tuy theo số ngày trong tháng)
vào cuộn số 10 (dòng thứ 18) để lấy số liệu

với lại tôi muốn sử dụng sự kiện, vi dụ như khi gõ 102910 vào Cell B13 xong thì nó xuất kết quả ra C13
code phức tạp quá nên không biết phải chỉnh như thế nào để được theo ý mình,
chừng nào anh rảnh và có hứng thì xem thử giúp nha
cám ơn anh nhiều

Bạn phải cố vân động lên mới mong viết code được
1. Tạo thêm biến FileName lấy tên file bằng cách dùng hàm Mid để lấy tên file từ ô chỉ định
vd: FileName = ThisWorkbook.Path & "\" & Mid([A1], 1, 2) & ".xls"
2. Tạo thêm biến Sheet lấy tên sheet bằng cách dùng hàm Mid để lấy tên sheettừ ô chỉ định
vd: Sheet = Mid([A1],3,2)
3. Sửa lại dòng code này StrRequest = "SELECT * FROM [" & Sheet & "$B9:V10000]"
Nếu tại A1 bạn có dữ liệu là 1030.... thì bạn sẽ truy xuất đến file có tên 10.xls và chọn sheet có tên là 30, vùng B9:V10000
4. Cần gì phải chỉ định từ dòng nào vì đúng mã mới lấy kết quả mà

Nói thật ADO này mình mới mò có 3 ngày nay thôi nên hướng dẫn sai là cái chắc

dhn46 · 31/10/13

Bài này có thể tạo thêm một Sheet trung gian Tmp rồi chạy câu lệnh Sql

Mã:

Sub ADO()
    On Error GoTo Handle
    Dim cnn As Object, lsSQL As String, lrs As Object, FileFullName As String
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    FileFullName = Application.ThisWorkbook.FullName
    With cnn
        If Val(Application.Version) < 12 Then
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 12.0;HDR=No"";"
        End If
        .Open
    End With


    lsSQL = "SELECT f2,f22 From [Excel 8.0;Database=" & ThisWorkbook.Path & _
            "\nguon.xls;HDR=No].[29$A9:V65536] Where f2 Is Not Null"
    lrs.Open lsSQL, cnn, 3, 1
    Sheets("Tmp").[A1:B6000].ClearContents
    Sheets("Tmp").Range("A1").CopyFromRecordset lrs
    lrs.Close
    
    lsSQL = "Select T1.f1,T2.f2 From [28$B13:C77] T1 " & _
            "Inner join " & _
            "(Select * From [Tmp$A1:B65536]) T2 " & _
            "On T1.f1=T2.f1"
    lrs.Open lsSQL, cnn, 3, 1
    Sheets("28").[C13:C77].ClearContents
    Sheets("28").Range("B13").CopyFromRecordset lrs
    Sheets("Tmp").[A1:B6000].ClearContents
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub

Hai Lúa Miền Tây · 1/11/13

dhn46 đã viết:

Bài này có thể tạo thêm một Sheet trung gian Tmp rồi chạy câu lệnh Sql

Mã:

Sub ADO()
    On Error GoTo Handle
    Dim cnn As Object, lsSQL As String, lrs As Object, FileFullName As String
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    FileFullName = Application.ThisWorkbook.FullName
    With cnn
        If Val(Application.Version) < 12 Then
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 12.0;HDR=No"";"
        End If
        .Open
    End With


    lsSQL = "SELECT f2,f22 From [Excel 8.0;Database=" & ThisWorkbook.Path & _
            "\nguon.xls;HDR=No].[29$A9:V65536] Where f2 Is Not Null"
    lrs.Open lsSQL, cnn, 3, 1
    Sheets("Tmp").[A1:B6000].ClearContents
    Sheets("Tmp").Range("A1").CopyFromRecordset lrs
    lrs.Close
    
    lsSQL = "Select T1.f1,T2.f2 From [28$B13:C77] T1 " & _
            "Inner join " & _
            "(Select * From [Tmp$A1:B65536]) T2 " & _
            "On T1.f1=T2.f1"
    lrs.Open lsSQL, cnn, 3, 1
    Sheets("28").[C13:C77].ClearContents
    Sheets("28").Range("B13").CopyFromRecordset lrs
    Sheets("Tmp").[A1:B6000].ClearContents
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub

Sao bạn không dùng Update cho nó gọn và khỏi cần sheet tạm:

[GPECODE=sql]Sub Update_HLMT()
Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
Sheets("28").Range("C13:C77").ClearContents
With cn
.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\10.xls;" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"
.Execute "UPDATE [29$A9:V100] a " _
& "INNER JOIN " _
& "[Excel 8.0;HDR=No;IMEX=2;DATABASE=" & ThisWorkbook.FullName & "].[28$B13:C77] b " _
& "ON a.F2=b.F1 " _
& "SET b.F2=a.F22"
.Close
End With
Set cn = Nothing

End Sub

[/GPECODE]

Quang_Hải · 1/11/13

Hai Lúa Miền Tây đã viết:
Sao bạn không dùng Update cho nó gọn và khỏi cần sheet tạm:

[GPECODE=sql]Sub Update_HLMT()
Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
Sheets("28").Range("C13:C77").ClearContents
With cn
.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\10.xls;" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"
.Execute "UPDATE [29$A9:V100] a " _
& "INNER JOIN " _
& "[Excel 8.0;HDR=No;IMEX=2;DATABASE=" & ThisWorkbook.FullName & "].[28$B13:C77] b " _
& "ON a.F2=b.F1 " _
& "SET b.F2=a.F22"
.Close
End With
Set cn = Nothing

End Sub

[/GPECODE]

Chạy code thử thấy quá hay nhưng chẳng hiểu gì ráo. Hic, chắc phải ngâm cứu mất mấy tuần.
Phải chi HLMT chú thích diễn giải thì hay quá

Hai Lúa Miền Tây · 1/11/13

Hai Lúa Miền Tây đã viết:
Sao bạn không dùng Update cho nó gọn và khỏi cần sheet tạm:

[GPECODE=sql]Sub Update_HLMT()
Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
Sheets("28").Range("C13:C77").ClearContents
With cn
.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\10.xls;" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"
.Execute "UPDATE [29$A9:V100] a " _
& "INNER JOIN " _
& "[Excel 8.0;HDR=No;IMEX=2;DATABASE=" & ThisWorkbook.FullName & "].[28$B13:C77] b " _
& "ON a.F2=b.F1 " _
& "SET b.F2=a.F22"
.Close
End With
Set cn = Nothing

End Sub

[/GPECODE]

(6) .Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
(7) "Data Source=" & ThisWorkbook.Path & "\10.xls;" & _

(8) "Extended Properties=""Excel 8.0;HDR=No;"";"

* 6+7+8: Kết nối với file nguồn 10.xls nằm chung folder với file chạy này. HDR=No là không dùng tên của tiêu đề cột của file 10.xls

(9).Execute "UPDATE [29$A9:V100] a " _
(10) & "INNER JOIN " _

(11) & "[Excel 8.0;HDR=No;IMEX=2;DATABASE=" & ThisWorkbook.FullName & "].[28$B13:C77] b " _

(12) & "ON a.F2=b.F1 " _

(13) & "SET b.F2=a.F22"

* 9+10+11+12+13:

- (9): Thực hiện việc cập nhật : Tôi đặt tên cho [29$A9:V100] của file 10.xls là a
- (10): Tiến hành ghép nối bảng
- (11): Tôi đặt vùng dữ liệu 28$B13:C77 của file Dich.xls là b
- (12): Điều kiện nối bảng là cột 2 của a = cột 1 cột b
- (13): Cập nhật dữ liệu vào bảng b: Cột 2 của b sẽ bằng dữ liệu cột 22 của a

Lấy Dữ Liệu Mà Không mở file nguồn (1 người xem)

Người dùng đang xem chủ đề này

Let'GâuGâu

Thành viên mới

File đính kèm

ndu96081631

Huyền thoại GPE

Quang_Hải

Thành viên gạo cội

Quang_Hải

Thành viên gạo cội

Let'GâuGâu

Thành viên mới

File đính kèm

Quang_Hải

Thành viên gạo cội

dhn46

Hướng tới tương lai

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆

Quang_Hải

Thành viên gạo cội

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.