Trích rút 1 phần dữ liệu từ file đóng (1 người xem)

[hngiatuong]

Em có 1 file dữ liệu có dung lượng rất lớn, trong khi đó em chỉ cần 1 phần số liệu trong đó. Khi mở file ra đã rất lâu mà lại bôi đen, lọc sau đó copy phần cần thiết sang file khác thì khá lâu (nhiều khi bỏ ra uống nước rồi vào làm tiêp).
Em muốn trích rút 1 phần dữ liệu trong file, thỏa mãn 2 điều kiện cho trước và có thể để không cùng 1 thư mục

 

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

Em có 1 file dữ liệu có dung lượng rất lớn, trong khi đó em chỉ cần 1 phần số liệu trong đó. Khi mở file ra đã rất lâu mà lại bôi đen, lọc sau đó copy phần cần thiết sang file khác thì khá lâu (nhiều khi bỏ ra uống nước rồi vào làm tiêp).
Em muốn trích rút 1 phần dữ liệu trong file, thỏa mãn 2 điều kiện cho trước và có thể để không cùng 1 thư mục

Làm cho bạn câu 1 + 2, câu còn lại bạn tự làm nhé.

Sub RutTrich()
    Dim cn As Object
    Dim rst As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.Jet.OleDb.4.0;Data Source=" & ThisWorkbook.Path & "\File Dulieu.xls;Extended properties=""Excel 8.0"";")
    Set rst = cn.Execute("Select " & Sheet3.[A1] & ",r.[" & Sheet1.[L3] & "] " & _
                         "from [Dulieu$A2:F1000] as dt " & _
                            "LEFT JOIN [" & ThisWorkbook.FullName & "].[DSach$B3:L1000] AS R " & _
                                        "ON dt.[" & Sheet1.[B3] & "]=r.[" & Sheet1.[B3] & "] " & _
                         "where [" & Sheet4.Range("L1") & "] = '" & Sheet4.Range("L2") & "'")
    Sheet4.Range("A4:H1000").ClearContents
    Sheet4.Range("A4").CopyFromRecordset rst
End Sub

 

[hngiatuong]

Làm cho bạn câu 1 + 2, câu còn lại bạn tự làm nhé.

Vâng. Em cảm ơn anh nhiều ạ. Nhưng khi thay đổi L1 và L2 thì không được nhỉ (VD L1 = tên điểm bán và L2= tên 1 ai đó chẳng hạn).
Mà thôi anh ạ như thế là ổn rồi. Anh bỏ giúp em ĐK L1 đi được không chỉ cần 1 ĐK L2 thôi ạ.

 

[thienduc2015]

Em có yêu cầu tương tự bạn hngiatuong. Em đã sưu tầm được 1 file trích rút dữ liệu trên GPE, nhưng nghẹt cái là em cứ phải copy vào file dữ liệu Sheet1 rồi mới trích rút sang Sheet2 (Trích lọc). Mà copy được sang thì nhiều khi mất cả tiếng.
Nay em muốn nhờ các anh chị sửa giúp Code để trích rút được dữ liệu từ file đóng có tên là "CDBHXH Thang 1" mà không phải là từ Sheet Dữ liệu như trong file. Xin các anh giúp đỡ.
Em đã xóa bớt để cho file nhẹ chứ dữ liệu tương đối nhiều ạ.
Vì mỗi tháng có 1 file trên gửi xuống nên tên file tháng sau có thể khác với tên file tháng trước, nếu có chế độ chọn file khi trích rút thì vô cùng tuyệt.
Làm phiền các anh chị giúp tách Sheet1 (Sheet dữ liệu thành 1 file khác để làm file gốc ạ)
Xin được cảm ơn các anh chị và chúc anh chị 1 ngày làm việc vui vẻ.

 

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

Vâng. Em cảm ơn anh nhiều ạ. Nhưng khi thay đổi L1 và L2 thì không được nhỉ (VD L1 = tên điểm bán và L2= tên 1 ai đó chẳng hạn).
Mà thôi anh ạ như thế là ổn rồi. Anh bỏ giúp em ĐK L1 đi được không chỉ cần 1 ĐK L2 thôi ạ.

Sao lại thôi, tôi chỉnh lại cho bạn 1 tí là được (Chổ màu đỏ bên dưới). Xin lỗi vì tôi chưa test kỷ.

Sub RutTrich()
    Dim cn As Object
    Dim rst As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.Jet.OleDb.4.0;Data Source=" & ThisWorkbook.Path & "\File Dulieu.xls;Extended properties=""Excel 8.0"";")
    Set rst = cn.Execute("Select " & Sheet3.[A1] & ",r.[" & Sheet1.[L3] & "] " & _
                         "from [Dulieu$A2:F1000] as dt " & _
                            "LEFT JOIN [" & ThisWorkbook.FullName & "].[DSach$B3:L1000] AS R " & _
                                        "ON dt.[" & Sheet1.[B3] & "]=r.[" & Sheet1.[B3] & "] " & _
                         "where[SIZE=5][B][COLOR=#ff0000] dt.[/COLOR][/B][/SIZE][" & Sheet4.Range("L1") & "] = '" & Sheet4.Range("L2") & "'")
    Sheet4.Range("A4:H1000").ClearContents
    Sheet4.Range("A4").CopyFromRecordset rst
End Sub

 

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

Em có yêu cầu tương tự bạn hngiatuong. Em đã sưu tầm được 1 file trích rút dữ liệu trên GPE, nhưng nghẹt cái là em cứ phải copy vào file dữ liệu Sheet1 rồi mới trích rút sang Sheet2 (Trích lọc). Mà copy được sang thì nhiều khi mất cả tiếng.
Nay em muốn nhờ các anh chị sửa giúp Code để trích rút được dữ liệu từ file đóng có tên là "CDBHXH Thang 1" mà không phải là từ Sheet Dữ liệu như trong file. Xin các anh giúp đỡ.
Em đã xóa bớt để cho file nhẹ chứ dữ liệu tương đối nhiều ạ.
Vì mỗi tháng có 1 file trên gửi xuống nên tên file tháng sau có thể khác với tên file tháng trước, nếu có chế độ chọn file khi trích rút thì vô cùng tuyệt.
Làm phiền các anh chị giúp tách Sheet1 (Sheet dữ liệu thành 1 file khác để làm file gốc ạ)
Xin được cảm ơn các anh chị và chúc anh chị 1 ngày làm việc vui vẻ.

Bỏ chung file Data.xlsx vào chung folder (Tìm file động bạn tự tìm trên diễn đàn nhé). Cấu trúc phải giống file mẫu.

Sub TruyVan()
    Dim cnn As Object
    Dim rst As Object
    Set cnn = CreateObject("ADODB.CONNECTION")
    cnn.Open "Driver=Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb);DBQ=" & ThisWorkbook.Path & "\Data.xlsx"
    Set rst = cnn.Execute("SELECT * FROM [Dulieu$A2:G10000] where [" & Sheet2.Range("I1") & "] like '" & Sheet2.Range("I2") & "'")
    Sheet2.Range("A3:G1000").ClearContents
    Sheet2.Range("A3").CopyFromRecordset rst
    
End Sub

 

[thienduc2015]

Bỏ chung file Data.xlsx vào chung folder. Cấu trúc phải giống file mẫu.

EM CẢM ƠN ANH NHIỀU, NHƯNG SAO EM GẶP LỖI DÒNG NÀY
[TABLE="width: 173"]
[TR]
[TD="class: xl66, width: 173"]cnn.Open "Driver=Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb);DBQ=" & ThisWorkbook.Path & "\Data.xlsx"
ANH CHỈ CHO EM BIẾT VỚI
[/TD]
[/TR]
[/TABLE]

 

[hngiatuong]

tôi chỉnh lại cho bạn 1 tí là được (Chổ màu đỏ bên dưới)

Em cảm ơn anh rất nhiều. Em hài lòng rồi ạ, nhưng Nếu tên Sheet của file cần trích mà không phải là "Dulieu" thì không được như vậy vẫn cần phải mở file lên để sửa lại tên Sheet là Dulieu mới được. (Phần phụ: giá như lựa chọn được L1 & L2 theo ĐK cột E & F thì hoàn hảo).
Một lần nữa xin được cảm ơn anh.

 

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

Em cảm ơn anh rất nhiều. Em hài lòng rồi ạ, nhưng Nếu tên Sheet của file cần trích mà không phải là "Dulieu" thì không được như vậy vẫn cần phải mở file lên để sửa lại tên Sheet là Dulieu mới được. (Phần phụ: giá như lựa chọn được L1 & L2 theo ĐK cột E & F thì hoàn hảo).
Một lần nữa xin được cảm ơn anh.

Chỉnh lại cho bạn:

Sub RutTrich()
    Dim cn As Object
    Dim rst As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.Jet.OleDb.4.0;Data Source=" & ThisWorkbook.Path & "\File Dulieu.xls;Extended properties=""Excel 8.0"";")
    Set rst = cn.Execute("Select " & Sheet3.[A1] & ",r.[" & Sheet1.[L3] & "] " & _
                         "from [" & Sheet4.Range("K2") & "$A2:F1000] as dt " & _
                            "LEFT JOIN [" & ThisWorkbook.FullName & "].[DSach$B3:L1000] AS R " & _
                                        "ON dt.[" & Sheet1.[B3] & "]=r.[" & Sheet1.[B3] & "] " & _
                         "where dt.[" & Sheet4.Range("L1") & "] like " & IIf(IsNumeric(Sheet4.Range("L2")), Sheet4.Range("L2"), "'" & Sheet4.Range("L2") & "'"))
    Sheet4.Range("A4:H1000").ClearContents
    Sheet4.Range("A4").CopyFromRecordset rst
End Sub

 

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

EM CẢM ƠN ANH NHIỀU, NHƯNG SAO EM GẶP LỖI DÒNG NÀY
[TABLE="width: 173"]
[TR]
[TD="class: xl66, width: 173"]cnn.Open "Driver=Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb);DBQ=" & ThisWorkbook.Path & "\Data.xlsx"
ANH CHỈ CHO EM BIẾT VỚI
[/TD]
[/TR]
[/TABLE]

Nhưng nó báo lỗi như thế nào vậy bạn?

 

[thienduc2015]

Nhưng nó báo lỗi như thế nào vậy bạn?

Nó bôi vàng dòng đó ạ. Em quên không nói là em dùng Excell 2003 không biết có liên quan không. Nhưng #9 giống công việc của em nên em lấy luôn bài đó được rồi. Em cảm ơn anh nhiều
Có điều này em thấy, nhưng chỉ là ý tưởng thôi nhé, không có ý làm phiền anh nữa. Chỗ nhập tên Sheet ấy: nếu vậy phải mở File lên (mất chừng 15 phút) để xem người gửi file đặt tên Sheet là gì, mà đã phải mở file thì mình đổi tên Sheet luôn (dùng #5 là ngon lắm rồi). Còn nếu có thể dò tìm trong file nguồn với các Sheet (không hạn chế tên Sheet) xem có thỏa mãn L1 và L2 không thì trích sang thì Sheet kết quả thì trên cả tuyệt vời. Xin anh thông cảm cho em, em chỉ muốn nói ý tưởng của em thôi, không có ý: Có voi đòi tiên đâu ạ.

 

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

Nó bôi vàng dòng đó ạ. Em quên không nói là em dùng Excell 2003 không biết có liên quan không. Nhưng #9 giống công việc của em nên em lấy luôn bài đó được rồi. Em cảm ơn anh nhiều
Có điều này em thấy, nhưng chỉ là ý tưởng thôi nhé, không có ý làm phiền anh nữa. Chỗ nhập tên Sheet ấy: nếu vậy phải mở File lên (mất chừng 15 phút) để xem người gửi file đặt tên Sheet là gì, mà đã phải mở file thì mình đổi tên Sheet luôn (dùng #5 là ngon lắm rồi). Còn nếu có thể dò tìm trong file nguồn với các Sheet (không hạn chế tên Sheet) xem có thỏa mãn L1 và L2 không thì trích sang thì Sheet kết quả thì trên cả tuyệt vời. Xin anh thông cảm cho em, em chỉ muốn nói ý tưởng của em thôi, không có ý: Có voi đòi tiên đâu ạ.

Code lấy tên sheet ở file đóng đã có nói ở diễn đàn. Trong bài đố vui ADO/DAO, bạn tìm đọc rồi ráp nối vào file để ứng dụng vào thực tế.
Gợi ý là lấy danh sách tên sheet cho vào list (Data validation chẳng hạn), từ đó chọn tên sheet theo ý.