Code lấy dữ liệu cho sheet!TonDau.

Liên hệ QC
NguyenthiH

NguyenthiH

Thành viên mới đăng ký
Tham gia
11/12/16
Bài viết
940
Được thích
172
Giới tính
Nữ
Chào các anh chị!!!!
Em có file-ThepHinh, và 3 file con (04-2024-WF1, 04-2024-WF3, 04-2024-WF6)
Em muốn lấy dữ liệu cột B (Mã Vật tư) sheet!BaoCao của 3 file con chép vào cột D sheet!TonDau của file ThepHinh
Lấy dữ liệu côt E (Số Lượng) Sheet!BaoCao của 3 file con chép vào cột J Sheet!TonDau của file ThepHinh
Cột L(nhà máy) Sheet!TonDau của file ThepHinh thì lấy dữ liệu của file con nào có tên số của file con đó. Ví dụ lấy file con 04-2024-WF1 thì tên Nhà Máy là VTF1.vv.v.
Nhưng chỉ lấy tên của vật tư không có phần diẽn giải là các chữ sau: "Plate" và "Chequered" và cột số lượng phải có.
Cách em làm thủ công như sau: Lọc những vật tư nào không có tên là "Plate" và "Cheqered" ra, xong lại lọc cột số lượng bỏ = 0 và Blank đi và rồi copy dán vào file ThepHinh ạ.
Mong các anh viết code để lấy dữ liệu ạ.
 

File đính kèm

  • ThepHinh.xlsb
    341.2 KB · Đọc: 11
  • 04-WF1.xlsb
    157 KB · Đọc: 14
  • 04-WF3.xlsb
    156.9 KB · Đọc: 11
  • 04-WF6.xlsb
    156.9 KB · Đọc: 11
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Mã vật tư có xuất hiện trong 3 file con bao giờ không vậy?
Bạn có thể tự code không?
Mở 3 lần lượt 3 file lên. xong xử lý dữ liệu rồi trả lại kết quả vào sheets đích thôi?
 
Upvote 0
Mã vật tư có xuất hiện trong 3 file con anh @BuiQuangThuan.
Em không tự viết code được.
Mong các anh giúp.
 
Upvote 0
NguyenthiH đã viết:
Chào các anh chị!!!!
Em có file-ThepHinh, và 3 file con (04-2024-WF1, 04-2024-WF3, 04-2024-WF6)
Em muốn lấy dữ liệu cột B (Mã Vật tư) sheet!BaoCao của 3 file con chép vào cột D sheet!TonDau của file ThepHinh
Lấy dữ liệu côt E (Số Lượng) Sheet!BaoCao của 3 file con chép vào cột J Sheet!TonDau của file ThepHinh
Cột L(nhà máy) Sheet!TonDau của file ThepHinh thì lấy dữ liệu của file con nào có tên số của file con đó. Ví dụ lấy file con 04-2024-WF1 thì tên Nhà Máy là VTF1.vv.v.
Nhưng chỉ lấy tên của vật tư không có phần diẽn giải là các chữ sau: "Plate" và "Chequered" và cột số lượng phải có.
Cách em làm thủ công như sau: Lọc những vật tư nào không có tên là "Plate" và "Cheqered" ra, xong lại lọc cột số lượng bỏ = 0 và Blank đi và rồi copy dán vào file ThepHinh ạ.
Mong các anh viết code để lấy dữ liệu ạ.
Nhấp chuột vào đây để mở rộng...
Trong khi chờ đợi code sịn, hãy tham khảo code củ chuối trong file.
Nhớ thay tên đường dẫn cho phù hợp ở ô P1
Nhấn nút chạy code để xem kết quả.
 

File đính kèm

  • ThepHinh.xlsb
    461.3 KB · Đọc: 13
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn anh @HUONGHCKT đã giúp đỡ, nhưng mong anh chỉnh code lại dùm em:
1/ trong máy em ổ D có nhiều file có tên *WF1*, *WF3*, *WF6*, nên mong anh chỉnh code cho hiện hôp để chọn file ạ (File Dialog) và có thể chọn 1 lúc cả 3 file.
2/ File giả định em đưa chỉ có 1 sheet!BaoCao (ActiveSheet) nhưng thực tế file có nhiều sheet, nên mong anh chỉnh code lấy đích danh sheet!BaoCao ạ.
3/ Chỉnh code để có dòng trống và bôi màu để phân cách dữ liệu của các nhà mấy ạ.
Mong anh @HUONGHCKT giúp đỡ ạ.
 
Upvote 0
NguyenthiH đã viết:
Cám ơn anh @HUONGHCKT đã giúp đỡ, nhưng mong anh chỉnh code lại dùm em:
1/ trong máy em ổ D có nhiều file có tên *WF1*, *WF3*, *WF6*, nên mong anh chỉnh code cho hiện hôp để chọn file ạ (File Dialog) và có thể chọn 1 lúc cả 3 file.
2/ File giả định em đưa chỉ có 1 sheet!BaoCao (ActiveSheet) nhưng thực tế file có nhiều sheet, nên mong anh chỉnh code lấy đích danh sheet!BaoCao ạ.
3/ Chỉnh code để có dòng trống và bôi màu để phân cách dữ liệu của các nhà mấy ạ.
Mong anh @HUONGHCKT giúp đỡ ạ.
Nhấp chuột vào đây để mở rộng...
Thích thì chiều, Xem file đính kèm (cho đủ 5 từ)
 

File đính kèm

  • ThepHinh.xlsb
    467.4 KB · Đọc: 10
Upvote 0
Anh @HUONGHCKT ơi, chỉnh dùm em không dùng Path file ở P1 được không anh, khi hiên hộp FileDialog thì chọn luôn file, không cần dùng Path file nữa..
Và khi code chạy dòng đầu của WF1 với dòng tiêu đề không cần chèn dòng trống ạ, chỉ từ Wf1 và WF3 thì mới cách 1 dòng trống, và WF3 và WF6 mới cách ra dòng trống. Và các dòng trống cách các nhà máy với nhau có màu cho dễ phân biệt ạ.
Cám ơn anh ạ.
 
Upvote 0
NguyenthiH đã viết:
Anh @HUONGHCKT ơi, chỉnh dùm em không dùng Path file ở P1 được không anh, khi hiên hộp FileDialog thì chọn luôn file, không cần dùng Path file nữa..
Và khi code chạy dòng đầu của WF1 với dòng tiêu đề không cần chèn dòng trống ạ, chỉ từ Wf1 và WF3 thì mới cách 1 dòng trống, và WF3 và WF6 mới cách ra dòng trống. Và các dòng trống cách các nhà máy với nhau có màu cho dễ phân biệt ạ.
Cám ơn anh ạ.
Nhấp chuột vào đây để mở rộng...
Bạn có thế thay thẳng path ở P1 vào trong code.
Nếu tôi hiểu đúng ý bạn thì có thể thay code cũ bằng code này
Mã: 
Sub ThepHinh()
Dim i&, d, t&, k&, Lr&, f&
Dim Arr(), Ma(), Ton(), Ten()
Dim Sh As Worksheet, Ws As Worksheet
Dim Wb As Workbook
Dim File As Variant, Path As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Call GetMultipleFiles
'Path = ActiveSheet.[P1]
ReDim Ma(1 To UBound(ArrFile) * 10000, 1 To 1)
ReDim Ton(1 To UBound(ArrFile) * 10000, 1 To 1)
ReDim Ten(1 To UBound(ArrFile) * 10000, 1 To 1)
ReDim d(1 To UBound(ArrFile))
For f = 1 To UBound(ArrFile)
    For Each File In CreateObject("Scripting.FileSystemObject").GetFolder("C:\Users\Admin\Downloads\Nguyen Thi H\").Files
        If File Like ArrFile(f) Then
            Set Wb = Workbooks.Open(File)
            For Each Sh In Wb.Worksheets
                If Sh.Name = "BaoCao" Then
                    Lr = Sh.Cells(Rows.Count, "B").End(xlUp).Row
                    If Lr <= 5 Then Exit For
                    Arr = Sh.Range("A6:E" & Lr).Value
                        For i = 1 To UBound(Arr)
                            If Arr(i, 5) > 0 Then
                                If InStr(Arr(i, 3), "Plate") = 0 Or InStr(Arr(i, 3), "Plate") = 0 Then
                                    t = t + 1
                                    Ma(t, 1) = Arr(i, 2)
                                    Ton(t, 1) = Arr(i, 5)
                                    Ten(t, 1) = File.Name
                                End If
                            End If
                        Next i
                    Wb.Close: d(f) = t: t = t + 1:
                End If
            Next Sh
        End If
    Next File
Next f
If t Then
    Set Ws = Sheets("TonDau")
        Ws.Range("D3:D100000").ClearContents
        Ws.Range("J3:J100000").ClearContents
        Ws.Range("L3:L100000").ClearContents
        Ws.Range("L3:L100000").Interior.Pattern = xlNone
        Ws.Range("D3").Resize(t, 1) = Ma
        Ws.Range("J3").Resize(t, 1) = Ton
        Ws.Range("L3").Resize(t, 1) = Ten
        Ws.Range("L3").Resize(d(1)).Interior.Color = 65535
        Ws.Range("L" & d(1) + 3).Resize(d(2)).Interior.Color = 15773696
'       Ws.Range("L" & d(2) + 3).Resize(d(3)).Interior.Color = 5296274
        Ws.Range("L" & d(2) + 3, "L" & Ws.Cells(Rows.Count, "L").End(3).Row).Interior.Color = 5296274

End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Done"

End Sub
Phần định dạng màu bạn có thể thay màu theo ý muốn)
 
Upvote 0
Bôi màu tư cột A sang cột L anh @HUONGHCKT ơi, của anh chỉ là bôi màu cột L à.
Không có cách nào thay luôn không cần Path File trong code luôn hả anh, khi hiện hộp chọn file thì chộn file rồi lấy dữ liệu chứ không cần đoạn code này:
Mã: 
For Each File In CreateObject("Scripting.FileSystemObject").GetFolder("C:\Users\Admin\Downloads\Nguyen Thi H\").Files
 
Upvote 0
NguyenthiH đã viết:
Bôi màu tư cột A sang cột L anh @HUONGHCKT ơi, của anh chỉ là bôi màu cột L à.
Không có cách nào thay luôn không cần Path File trong code luôn hả anh, khi hiện hộp chọn file thì chộn file rồi lấy dữ liệu chứ không cần đoạn code này:
Nhấp chuột vào đây để mở rộng...
@HUONGHCKT bị gọi tên liên tục nhỉ?
Thêm 1 cách khác cho bạn test thử. Hi vọng là các yêu cầu về sau của bạn mình đang hiểu đúng. Có sử dụng 1 phần code của thầy @HieuCD
Mã: 
Option Explicit
Sub ABC()
    Dim Arr(), FullFileName, Res(), i&, k&, sFile
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Excel Files", "*.xls*"
        If .Show = True Then
            Set sFile = .SelectedItems
        Else
            MsgBox ("Chua Chon File Lay Du Lieu!")
            Exit Sub
        End If
    End With
    ReDim Res(1 To 100000, 1 To 13)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets("TonDau").Range("A3:M10000").Interior.Color = xlNone
    For Each FullFileName In sFile
        With Workbooks.Open(FullFileName).Sheets("BaoCao")
            Arr = .Range("A6:E" & .Range("E65000").End(3).Row).Value
            .Parent.Close False
        End With
        For i = 1 To UBound(Arr)
            If Arr(i, 2) <> Empty Then
                If Not Arr(i, 2) Like "Plate" Then
                    If Not Arr(i, 2) Like "Chequered" Then
                        k = k + 1
                        Res(k, 4) = Arr(i, 2)
                        Res(k, 10) = Arr(i, 5)
                        Res(k, 12) = Split(Split(FullFileName, "\")(UBound(Split(FullFileName, "\"))), ".")(0)
                    End If
                End If
            End If
        Next
        k = k + 1
        Sheets("TonDau").Cells(k + 2, 1).Resize(, 13).Interior.Color = vbYellow
    Next
    With Sheets("TonDau")
        .Range("A3:M10000").ClearContents
        .Range("A3:M10000").Borders.LineStyle = 0
        .Range("A3").Resize(k, 13).Value = Res
        .Range("A3").Resize(k, 13).Borders.LineStyle = 1
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Hoan thanh"
End Sub
 
Upvote 0
Cám ơn anh @BuiQuangThuan nhiều, kết hợp với thầy @HieuCD thì quá tuyệt.
Nhưng chỉ xóa Cột D, cột J, cột L thôi ạ, mấy cột kia em có công thức ạ.

Mã: 
 .Range("A3:M10000").ClearContents
 
Upvote 0
NguyenthiH đã viết:
Bôi màu tư cột A sang cột L anh @HUONGHCKT ơi, của anh chỉ là bôi màu cột L à.
Không có cách nào thay luôn không cần Path File trong code luôn hả anh, khi hiện hộp chọn file thì chộn file rồi lấy dữ liệu chứ không cần đoạn code này:
Mã: 
For Each File In CreateObject("Scripting.FileSystemObject").GetFolder("C:\Users\Admin\Downloads\Nguyen Thi H\").Files
Nhấp chuột vào đây để mở rộng...
Tôi đã viết trong bài #4 là "Trong khi chờ đợi code sịn, hãy tham khảo code củ chuối trong file."
Đến giờ thì bạn đã có được điều muốn rồi code của bạn @BuiQuangThuan là code sịn đó. Tuy nhiên tôi vẫn muons bạn xác nhận là code của tôi( code củ chuối ấy ) chạy có ra kết quả đúng không? Có gắng bớt thời gian trả lời tôi nhé.
Việc tô màu từ cột A đến cột L thì bạn chỉ cần thay chỗ Ws.Range("L3").Resize(d(1)).Interior.Color = 65535 bằng Ws.Range("A3").Resize(d(1), xxx).Interior.Color = 65535 là được .
Còn việc có hay không có thêm dòng For Each File In CreateObject("Scripting.FileSystemObject").GetFolder("C:\Users\Admin\Downloads\Nguyen Thi H\").Files theo tôi cũng không quan trọng bằng code ra đươpcj kết quả thế nào.
 
Lần chỉnh sửa cuối:
Upvote 0
NguyenthiH đã viết:
Nhưng chỉ xóa Cột D, cột J, cột L thôi ạ, mấy cột kia em có công thức ạ.

Mã: 
 .Range("A3:M10000").ClearContents
Nhấp chuột vào đây để mở rộng...
Bạn kì cựu rồi mà không biết phải sửa chỗ nào để xóa à?Thêm nữa là bạn biết chỗ mà chỉ đích danh chỗ cần sửa. Không lẽ cái nhỏ nhỏ cũng hỏi nó kỳ kì sao á. Cố gắng tìm hiểu rồi sửa xem.
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

T
Nhờ giúp tính tổng ô đã Merge
Trả lời
1
Đọc
15
Hoàng Trọng Nghĩa
Hoàng Trọng Nghĩa
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2 3 4
Trả lời
61
Đọc
891
LuuAnh980
LuuAnh980
S
Sao excel lại biến dữ liệu thành dữ liệu nhiều các con số?
Trả lời
7
Đọc
63
ongke0711
ongke0711
C
Hàm Textjoin nối chuỗi có định dạng ngày tháng
Trả lời
10
Đọc
408
polyvietnam
polyvietnam
emlat3
Đặt màu xen kẽ các dòng theo ký tự
Trả lời
5
Đọc
123
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom