Code lấy dữ liệu từ 3 file con.

[LuuAnh980]

Chào các anh trong GPE!!!!
Em có bắt chước code của anh @Hoàng Tuấn 868 làm cho em để lấy dữ liệu, nhưng không biết sai chổ nào mà báo lỗi ngay dòng này:

md(k, 11) = "VTF" & Mid(wn.Name, InStr(wn.Name, "WF") - 1, 1)

lỗi Subscript out of range ạ.
Code đây ạ:

Option Explicit

Sub LayDuLieuSheetTonDau_TuCacFile()
Application.ScreenUpdating = False
Dim wd As Workbook, wn As Workbook
Dim sd As Worksheet, sn As Worksheet, sn1 As Worksheet, sn2 As Worksheet
Dim lrd As Long, lrn As Long, lrn1 As Long, lrn2 As Long
Dim i As Long, j As Long, k As Long, p As Long, q As Long
Dim md() As String, md1, md2, mn, mn1, mn2

Set wd = ThisWorkbook
Set sd = wd.Sheets("TonDau")
Set sn1 = wd.Sheets("DanhMuc")

lrn1 = sn1.Cells(Rows.Count, 2).End(xlUp).Row
mn1 = sn1.Range("B6:j" & lrn1)


ReDim md(1 To 2000, 1 To 11)
ReDim md1(1 To 2000, 1 To 6)

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
If .SelectedItems.Count = 0 Then Exit Sub
    For i = 1 To .SelectedItems.Count
        Set wn = Workbooks.Open(.SelectedItems(i), False)
        Set sn = wn.Sheets("BaoCao")
        
        If sn.AutoFilterMode = True Then sn.AutoFilterMode = False
        lrn = sn.Cells(Rows.Count, 2).End(xlUp).Row
        mn = sn.Range("B8:E" & lrn)
        For j = 1 To UBound(mn, 1)
            If Trim(mn(j, 2)) <> "" And Left(mn(j, 2), 11) <> "Steel Plate" Or Trim(mn(j, 2)) <> "" And Left(mn(j, 2), 11) <> "Chequered" Then

                If InStr(mn(j, 2), "Steel Plate") = 0 Then
                    If InStr(mn(j, 2), "Chequered") = 0 Then
            On Error GoTo thoat
            
                    k = k + 1
                    md(k, 4) = mn(j, 1)
                    md1(k, 1) = mn(j, 3)
                    End If
                End If
md(k, 11) = "VTF" & Mid(wn.Name, InStr(wn.Name, "WF") - 1, 1)
End If
thoat:
        Next j
    k = k + 1
    wn.Close False
    Next i
    
    If k > 0 Then
    
    
        For p = 1 To UBound(mn1, 1)
            For q = 1 To k
                If mn1(p, 2) = md(q, 4) Then
                    md(q, 5) = mn1(p, 8)
                    md1(q, 9) = mn1(p, 7)
                End If
            Next q
        Next p
        
 
        sd.Range("A3:M10000").Clear
        sd.Range("A3").Resize(k, 11) = md
        sd.Range("J3").Resize(k - 1, 1) = md1
        lrd = sd.Cells(Rows.Count, 8).End(xlUp).Row
        sd.Range("A3:M" & lrd).Borders.LineStyle = True
  End If
End With

        For i = 6 To lrd - 1
        If sd.Cells(i, 1) = "" Then
            sd.Range("A" & i).Resize(1, 11) = ""
            sd.Range("A" & i).Resize(1, 11).Interior.ColorIndex = 37
        End If
    Next i
    
Application.ScreenUpdating = True
End Sub

 

[LuuAnh980]

anh @BuiQuangThuan Xong rồi anh. Nhưng tại các anh nói code chạy lòng vòng.

Đằng này chủ yếu chỉ là vá cho nên loogic giữa vấn đề và code trở nên rất lòng vòng.

 

[ptm0412]

Tôi thì không ngại viết code vô bổ.
Nhưng tôi có nguyên tắc về phân tích lô gic. Rất tiếc là nguyên tắc này không thích hợp với cách làm việc của thớt cho nên tôi không làm nữa.

Thì tôi cũng đã nói: Tôi viết xong, bỏ qua việc thêm dòng tô màu vô bổ, code của tôi cũng sẽ bị phá nữa mà thôi.