Giúp em: trích lọc danh sách khách hàng từ file tổng hợp sang file khác

[nhp131]

Chào mọi người,

Em có một bài toán nhờ các cao thủ chỉ giáo giúp:

Đề bài:
- Một file tổng hợp tên "Data" chứa thông tin của tất cả các khách hàng, file này được cập nhật liên tục theo đơn hàng
- Nhiều file riêng lẻ của từng khách hàng (ở đây em chỉ up 01 file "thutrang" làm ví dụ)

Yêu cầu:
- Khi nhập dữ liệu một đơn hàng bất kỳ mà khách hàng là thutrang vào file "Data", các thông tin này sẽ tự động được copy vào file riêng lẻ của thutrang, tương tự với các đơn hàng tiếp theo.

Rất mong nhận được sự trợ giúp của chư vị anh hùng, em xin chân thành cảm ơn!

 

[Hai Lúa Miền Tây]

Chào mọi người,

Em có một bài toán nhờ các cao thủ chỉ giáo giúp:

Đề bài:
- Một file tổng hợp tên "Data" chứa thông tin của tất cả các khách hàng, file này được cập nhật liên tục theo đơn hàng
- Nhiều file riêng lẻ của từng khách hàng (ở đây em chỉ up 01 file "thutrang" làm ví dụ)

Yêu cầu:
- Khi nhập dữ liệu một đơn hàng bất kỳ mà khách hàng là thutrang vào file "Data", các thông tin này sẽ tự động được copy vào file riêng lẻ của thutrang, tương tự với các đơn hàng tiếp theo.

Rất mong nhận được sự trợ giúp của chư vị anh hùng, em xin chân thành cảm ơn!

Dùng code sau:

Sub LayDL_HLMT()
    Dim strPath As String, strKhach As String
    strPath = ThisWorkbook.Path & "/Data.xlsx" ' Duong dan den file data cua du lieu
    strKhach = Sheet1.Range("B1") 'Dieu kien la ten khach hang can loc
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=Excel 12.0"
        Sheet1.Range("B4:E100").ClearContents
        Sheet1.Range("B4").CopyFromRecordset .Execute("Select * from [Sheet1$] where [Khách Hàng]='" & strKhach & "'")
    End With
End Sub

 

[nhp131]

Quá tuyệt vời, em cảm ơn anh rất nhiều ạ!

 

[nhp131]

Dùng code sau:

Sub LayDL_HLMT()
    Dim strPath As String, strKhach As String
    strPath = ThisWorkbook.Path & "/Data.xlsx" ' Duong dan den file data cua du lieu
    strKhach = Sheet1.Range("B1") 'Dieu kien la ten khach hang can loc
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=Excel 12.0"
        Sheet1.Range("B4:E100").ClearContents
        Sheet1.Range("B4").CopyFromRecordset .Execute("Select * from [Sheet1$] where [Khách Hàng]='" & strKhach & "'")
    End With
End Sub

[Cập nhật] Em làm được rồi, tự nhiên làm lại tất cả từ đầu thì lại được, không biết bị lỗi gì nữa! Cảm ơn anh Hai Lúa!

Chào anh Hai Lúa Miền Tây,

Sau khi áp dụng thành công mỹ mãn thì em phát sinh một vấn đề nho nhỏ nhờ anh cứu giúp:
- Em tạo một Macro nho nhỏ cho file Data, sau đó buộc phải lưu lại thành file *.xlsm
- Tìm hiểu Google thì để kết nối với file *xlsm này em phải sửa lại code một chút xíu:

Sub Button1_Click()

Dim strPath As String, strKhach As String
strPath = ThisWorkbook.Path & "/VK0000 Data.xlsm" ' Duong dan den file data cua du lieu
strKhach = Sheets("Data").Range("B1") 'Dieu kien la ten khach hang can loc
With CreateObject("ADODB.Connection")
.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strPath & ";" & _
"Extended Properties = ""Excel 12.0 Macro;HDR=YES"";"
Sheets("Data").Range("B5:BD1000").ClearContents
Sheets("Data").Range("B5").CopyFromRecordset .Execute("Select * from [Data$] where [Customers]='" & strKhach & "'")
End With

End Sub

- Tuy nhiên, khi chạy lên thì nó báo lỗi "No value given for one or more required parameters" ở dòng Sheets("Data").Range("B5").CopyFromRecordset .Execute("Select * from [Data$] where [Customers]='" & strKhach & "'")

Phiền anh xem giùm, cảm ơn anh!

 

[Hai Lúa Miền Tây]

[Cập nhật] Em làm được rồi, tự nhiên làm lại tất cả từ đầu thì lại được, không biết bị lỗi gì nữa! Cảm ơn anh Hai Lúa!

Chào anh Hai Lúa Miền Tây,

Sau khi áp dụng thành công mỹ mãn thì em phát sinh một vấn đề nho nhỏ nhờ anh cứu giúp:
- Em tạo một Macro nho nhỏ cho file Data, sau đó buộc phải lưu lại thành file *.xlsm
- Tìm hiểu Google thì để kết nối với file *xlsm này em phải sửa lại code một chút xíu:

Sub Button1_Click()

Dim strPath As String, strKhach As String
strPath = ThisWorkbook.Path & "/VK0000 Data.xlsm" ' Duong dan den file data cua du lieu
strKhach = Sheets("Data").Range("B1") 'Dieu kien la ten khach hang can loc
With CreateObject("ADODB.Connection")
.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strPath & ";" & _
"Extended Properties = ""Excel 12.0 Macro;HDR=YES"";"
Sheets("Data").Range("B5:BD1000").ClearContents
Sheets("Data").Range("B5").CopyFromRecordset .Execute("Select * from [Data$] where [Customers]='" & strKhach & "'")
End With

End Sub

- Tuy nhiên, khi chạy lên thì nó báo lỗi "No value given for one or more required parameters" ở dòng Sheets("Data").Range("B5").CopyFromRecordset .Execute("Select * from [Data$] where [Customers]='" & strKhach & "'")

Phiền anh xem giùm, cảm ơn anh!

Bạn gửi file tôi xem thử nhé.