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

[NguyenthiH]

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 ạ.

 

[BuiQuangThuan]

Anh @BuiQuangThuan giúp em với, em không rành VBA lắm.

Hên thì trúng xui trượt nhé.

Sub ABC()
    Dim Arr(), FullFileName, a(), b(), c(), 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 a(1 To 100000): b = a: c = a
    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 Arr(i, 5) > 0 Then
                    If Not Arr(i, 2) Like "Plate" Then
                        If Not Arr(i, 2) Like "Chequered" Then
                            k = k + 1
                            a(k) = Arr(i, 2)
                            b(k) = Arr(i, 5)
                            c(k) = Split(Split(FullFileName, "\")(UBound(Split(FullFileName, "\"))), ".")(0)
                        End If
                    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").Borders.LineStyle = 0
        .Range("D3").Resize(k).Value = WorksheetFunction.Transpose(a)
        .Range("J3").Resize(k).Value = WorksheetFunction.Transpose(b)
        .Range("L3").Resize(k).Value = WorksheetFunction.Transpose(c)
        .Range("A3").Resize(k, 13).Borders.LineStyle = 1
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Hoan thanh"
End Sub

 

[Hoàng Tuấn 868]

Thiệt không anh

Đúng vậy đó em ơi.

 

[BuiQuangThuan]

Đúng vậy đó em ơi.

Thêm từ "em ơi" nghe díu hết cả trái tim luôn ấy.

 

[LuuAnh980]

Đúng vậy đó em ơi.

Em nhắn cho anh Tuấn quá trời luôn, mà chẳng thấy anh trả lời, em nghĩ chắc anh cho em vào "Danh sách đen" rồi.
Khi nào công việc xong, giúp em nhé.

 

[NguyenthiH]

Hên quá trúng rồi anh @BuiQuangThuan ơi.
Em cám ơn anh nhiều ạ.
Chúc anh buổi tối thứ Bảy vui vẻ ạ.

 

[NguyenthiH]

Em cũng cám ơn anh @HUONGHCKT đã giúp đỡ em nhiều ạ.

Bài đã được tự động gộp: 20/4/24

À chưa kiểm tra kỹ, chổ code này lấy sai rồi anh @BuiQuangThuan ơi.

If Not Arr(i, 2) Like "Plate" Then
                If Not Arr(i, 2) Like "Chequered" Then

Tức là không lấy vật tư nào có tên là "Plate" và " Chequered"
Thế mà code lấy luuon anh. Mong anh chỉnh dùm code.

 

[NguyenthiH]

Mấy cái "Plate" và "Chequered" đây anh @BuiQuangThuan.

 

[BuiQuangThuan]

Mấy cái "Plate" và "Chequered" đây anh @BuiQuangThuan.
View attachment 300396View attachment 300397

Mình sẽ sửa lại sau khi ngồi máy. Chứ giờ không ngồi máy rồi. Hoặc có thể đọc code của chú @HUONGHCKT cái phần điều kiện đó sửa lại lag được

 

[NguyenthiH]

Cám ơn anh @BuiQuangThuan chỉ, em lấy code của anh @HUONGHCKT thay vào đã chạy đúng.
Cám ơn anh @HUONGHCKT !!!!!