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.

 

[VetMini]

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.

Code bị phá nhằm nhòi gì.
Đằng này lời nói còn bị bẻ nghĩa, khả năng gây hiềm khích với thành viên khác nữa.
Tôi nói "lô gic (liên hệ) giữa vấn đề và code trở nên rất lòng vòng"
Người bảo tôi nói "code chạy lòng vòng". Như vậy có phải đem tôi ra khích tướng mấy người viết code không?

 

[ptm0412]

Như vậy có phải đem tôi ra khích tướng mấy người viết code không?

Tôi chẳng lo. Bài trước tôi phân tích 8 điểm dở của code dù không biết của ai. Trước đó tôi còn phân tích cách tìm lỗi 5 phút mà không phải loay hoay cả tuần lễ. Lại còn phân tích việc chăm soi vào cái Instr "có thể bằng 0" mà không thấy nó tuyệt đối không thể bằng 0. Lại còn cố đóng (close) 1 file nhiều lần.
Tất cả những cái đó là động chạm kha khá người trong chủ đề này. Tuy vậy tôi tin rằng họ nhận ra rằng tôi nhận xét đúng, không dễ khích họ.

 

[ptm0412]

Bài 37 có file có code mới, không phải code cũ sửa lại. Tôi có xem và thấy nó cũng chạy được. Nhưng chắc bị chê vì kết quả không chèn dòng trống và tô màu. Còn thuật toán hay hơn hay dở hơn thì chắc không cần biết.