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

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

LuuAnh980

Thành viên tiêu biểu
Tham gia
28/9/22
Bài viết
453
Được thích
104
Giới tính
Nữ
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:
Mã:
md(k, 11) = "VTF" & Mid(wn.Name, InStr(wn.Name, "WF") - 1, 1)
lỗi Subscript out of range ạ.
Code đây ạ:
Mã:
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
 
Đang hỏi, vì thầy Mỹ đã chỉ thì các anh biết các anh chỉnh dùm trên code đó luôn đi, còn hỏi đề bài làm gì nữa.
Bài đã được tự động gộp:

Code đang lỗi ở cột L, mục số 4, biến k =0, các anh biết các anh chỉnh có tí là xong thôi.
Bài đã được tự động gộp:

Cười gì hoài anh @BuiQuangThuan , anh biết anh chỉnh code trên dùm đi, Chúc anh nghỉ lễ vui vẻ.
 
Lần chỉnh sửa cuối:
Upvote 0
Đang hỏi, vì thầy Mỹ đã chỉ thì các anh biết các anh chỉnh dùm trên code đó luôn đi, còn hỏi đề bài làm gì nữa.
Bài đã được tự động gộp:

Code đang lỗi ở cột L, mục số 4, biến k =0, các anh biết các anh chỉnh có tí là xong thôi.
Bài đã được tự động gộp:

Cười gì hoài anh @BuiQuangThuan , anh biết anh chỉnh code trên dùm đi, Chúc anh nghỉ lễ vui vẻ.
Đặt lệnh md(k, 11) = "VTF" & Mid(wn.Name, InStr(wn.Name, "WF") - 1, 1)
sau dòng k= k+1
Có 2 dòng k= k+1, đặt ở đâu là tùy bạn

Chỉ chữa cháy tạm, còn lại tự xử
 
Upvote 0
Trời, anh Hiếu đã ra tay cứu vớt em, dạ để em thử ạ.
Cám ơn anh Hiếu nhiều.
Bài đã được tự động gộp:

vẫn lỗi anh Hiếu ơi, mình bỏ đi 1 dòng k=k+1 hả anh.????
 
Lần chỉnh sửa cuối:
Upvote 0
Code đang lỗi ở cột L, mục số 4, biến k =0, các anh biết các anh chỉnh có tí là xong thôi.
Bài 38 nói: " k khởi tạo dĩ nhiên là bằng 0; k = k + 1 nằm trong tận 2 dấu if End if, khi if không thỏa mãn thì k= 0 thôi."
Thì khi thỏa điều kiện câu lệnh gán giá trị md(k, 11) phải nằm ở chỗ thỏa điều kiện tức là chỗ k đã + 1. Tức là nằm trong If-End If, như bài 42 chỉ dẫn. Chứ nằm ngoài tức là không thỏa điều kiện, k = 0 chứ sao. Bạn thật tình là không muốn động não 1 chút nào. y như tôi nhận xét từ đầu.

Còn việc xóa On Error Goto và xóa thoat
khi xóa thoat phải xóa luôn câu lệnh bên dưới thoat (k = k +1), nếu không kết quả sẽ sinh ra các dòng trống. Khi có quá nhiều dòng trống thì lại vượt kích thước mảng kết quả.
 
Upvote 0
Trời, anh Hiếu đã ra tay cứu vớt em, dạ để em thử ạ.
Cám ơn anh Hiếu nhiều.
Bài đã được tự động gộp:

vẫn lỗi anh Hiếu ơi, mình bỏ đi 1 dòng k=k+1 hả anh.????
Code bạn bị vướng tùm lum tùm la sửa mệt hơn viết mới, nói rỏ cần làm gì các bạn trên diễn đàn sẽ giúp viết lại code.
 
Upvote 0
Có "Động não" chứ Thày Mỹ, nhưng có biết tí gì đâu mà chỉnh thầy Mỹ.
Bạn thật tình là không muốn động não 1 chút nào. y như tôi nhận xét từ đầu.
Bài đã được tự động gộp:

Code bạn bị vướng tùm lum tùm la sửa mệt hơn viết mới, nói rỏ cần làm gì các bạn trên diễn đàn sẽ giúp viết lại code.
Thì em có nói rồi đó anh Hiếu. Bài #39
 
Upvote 0
Em đã làm theo, nhưng code chạy vẫn lỗi thầy Mỹ:
Mã:
                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, 11) = "VTF" & Mid(wn.Name, InStr(wn.Name, "WF") - 1, 1)
                    md(k, 4) = mn(j, 1)
                    md1(k, 1) = mn(j, 3)
                    End If
                End If
Phải vầy không thầy Mỹ.
 
Upvote 0
Em đã làm theo, nhưng code chạy vẫn lỗi thầy Mỹ:
Mã:
                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, 11) = "VTF" & Mid(wn.Name, InStr(wn.Name, "WF") - 1, 1)
                    md(k, 4) = mn(j, 1)
                    md1(k, 1) = mn(j, 3)
                    End If
                End If
Phải vầy không thầy Mỹ.
Còn câu "xóa On Error Goto và xóa thoat: khi xóa thoat phải xóa luôn câu lệnh bên dưới thoat (k = k +1)"
sao không đọc, không làm theo?

Việc xóa này đã nói từ bài 28

1714453904066.png
 
Upvote 0
Em làm thì thấy nó lấy dữ liệu sai, đúng ra là cột L là số 12, mà code cũ là 11
Mã:
md(k, 11) = "VTF" & Mid(wn.Name, InStr(wn.Name, "WF") - 1, 1)
em thay là 12 thì lỗi ngay dòng
Mã:
md(k, 12) = "VTF" & Mid(wn.Name, InStr(wn.Name, "WF") - 1, 1)
Mong thầy Mỹ giúp.
 
Upvote 0
Dạ tới cột M, là 13 cột thầy, em đã chỉnh Redim md(1 to 2000, 1 to 13) sao nó chạy lấy dữ liệu không đúng, thôi thiệt tình em xin lỗi các anh và thầy Mỹ. Mong các anh và thầy viết cho em code mới luôn ạ, chứ giờ chỉnh sửa hư hoài. Mong mọi người giúp em.
 
Upvote 0
Cái thằng cha già chết tiệt ấy nói sai. Thớt không hẳn mắc bệnh lười động não.
Theo tôi thì thớt mắc bệnh chủ quan (subjective) và thành kiến (prejudice)
Thớt chỉ đọc thôi chứ gần như bỏ ngoài tai những lời nói không hợp ý mình.

Điển hình: cha già chết tiệt đã mách khi gặp lỗi "subscript out of range" thì phải bảo khung immediate in ra đủ dimensions của mảng.
Khi lão ta hỏi lại lần nữa về độ lớn của md thì thớt chỉ nói vỏn vẹn là 13, tức cột M.
Nếu là tôi thì tôi gõ vào immediate như sau:
? LBound(md), UBound(md), LBound(md), UBound(md,2)
? Mid(wn.Name, InStr(wn.Name, "WF") - 1, 1)
 
Upvote 0
Cái thằng cha già chết tiệt ấy nói sai. Thớt không hẳn mắc bệnh lười động não.
Theo tôi thì thớt mắc bệnh chủ quan (subjective) và thành kiến (prejudice)
Thớt chỉ đọc thôi chứ gần như bỏ ngoài tai những lời nói không hợp ý mình.
Tôi đọc code từ bài 1, và đọc code trong file có chạy kiểm tra lỗi, và nhớ rằng chỉ Redim 11 cột. Lỗi tôi phát hiện và hướng dẫn sửa thì sau bài 50 không phản hồi chạy được hay chưa; lại sinh ra lỗi do gán vào cột 12. Từ chỗ này sinh ra 2 nguyên nhân có thể sinh ra lỗi:
- Lỗi cũ, sửa chưa hết
- Không biết Redim 12 cột chưa mà gán vào cột 12

Cho nên tôi định hỏi từng lần, mỗi lần 1 nguyên nhân để loại trừ. Hỏi 2 câu 1 lúc thì tôi quá biết là sẽ chỉ trả lời 1 (giống như bài 44 hướng dẫn 2 chuyện cũng không làm, sau đó chỉ làm 1 chuyện).

Nếu lỗi cũ sau khi sửa 2 chuyện đó đã chạy tốt rồi (tôi đã test), thì lỗi cột 12 là 1 lỗi mới, lẽ ra nên đưa code mới lên lại xem thử đã phá thêm những gì.

Nói thêm:
LBound, Ubound có thể xem lại chỗ Redim, chưa cần Immediate
InStr(wn.Name, "WF") - 1 theo như tôi phân tích ở bài 34 thì tên file luôn luôn có sẵn "WF" và nằm tít đằng sau, Instr dù trừ 1 cũng không thể bằng 0
 
Upvote 0
Cám ơn các anh và thầy Mỹ đã hướng dẫn, sau gần 1 tháng em đã làm được code chạy rồi, nhưng sao em thấy nó vẫn giựt màn hình.
Mặc dù code dòng đầu có:
Mã:
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
và cuối có:
Mã:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
và code mới đây ạ:
Mã:
Sub LayDuLieuSheetIssue_TuCacFile()
Application.ScreenUpdating = False
Dim wd As Workbook, wn As Workbook
Dim sd As Worksheet, sn As Worksheet
Dim Lrd As Long, lrn As Long, lrn1 As Long
Dim i As Long, j As Long, k As Long, p As Long, q As Long
Dim md() As String, md1, mn
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

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


ReDim md(1 To 2000, 1 To 13)
ReDim md1(1 To 2000, 1 To 5)

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("A8:E" & lrn)
        For j = 1 To UBound(mn, 1)
                If mn(j, 5) > 0 Then
                    If InStr(mn(j, 3), "Steel Plate") = 0 Or InStr(mn(j, 3), "Steel Plate") = 0 Then
                        If InStr(mn(j, 3), "Chequered") = 0 Or InStr(mn(j, 3), "Chequered") = 0 Then
                        On Error GoTo thoat
            
                        k = k + 1
                        md(k, 4) = mn(j, 2)
                        md(k, 5) = mn(j, 3)
                        md1(k, 1) = mn(j, 5)
                        md(k, 12) = "VTF" & Left(Right(wn.Name, 6), 1)
                    End If
                End If
            End If
thoat:
        Next j
    k = k + 1
    wn.Close False
    Next i
    
    If k > 0 Then
    
        
 
        sd.Range("A3:M2000").Clear
        sd.Range("A3").Resize(k, 13) = md
        sd.Range("J3").Resize(k - 1, 1) = md1
        Lrd = sd.Cells(Rows.Count, 4).End(xlUp).Row
        sd.Range("A3:M" & Lrd).Borders.LineStyle = True
  End If
End With

        sd.Range("E3").Formula = "=IF($D3<>"""",VLOOKUP($D3,'DanhMuc'!$B$6:$I$543,8,0),"""")"
        sd.Range("E3:E" & Lrd).FillDown
        sd.Range("F3").Formula = "=IF($D3<>0,VLOOKUP($D3,'DanhMuc'!$B$6:$I$1042,4,0),"""")"
        sd.Range("F3:F" & Lrd).FillDown
        sd.Range("G3").Formula = "=IF($D3<>0,VLOOKUP($D3,'DanhMuc'!$B$6:$I$1042,5,0),"""")"
        sd.Range("G3:G" & Lrd).FillDown
        sd.Range("H3").Formula = "=IF($D3<>0,VLOOKUP($D3,'DanhMuc'!$B$6:$I$1042,6,0),"""")"
        sd.Range("H3:H" & Lrd).FillDown
        sd.Range("I3").Formula = "=IF($D3<>0,VLOOKUP($D3,'DanhMuc'!$B$6:$I$1042,7,0),"""")"
        sd.Range("I3:I" & Lrd).FillDown
        sd.Range("K3").Formula = "=IFERROR(J3*I3,"""")"
        sd.Range("K3:K" & Lrd).FillDown

    For i = 3 To Lrd - 1
        If sd.Cells(i, 4) = "" Then
            sd.Range("A" & i).Resize(1, 13) = ""
            sd.Range("A" & i).Resize(1, 13).Interior.ColorIndex = 35
        End If
    Next i
    
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
File đính kèm ạ.
Mong các anh và thầy Mỹ xem hộ code và chỉ ra chổ nào có vấn đề ạ.
 

File đính kèm

Upvote 0
Đọc 2 câu lệnh này:
Mã:
If InStr(mn(j, 3), "Steel Plate") = 0 Or InStr(mn(j, 3), "Steel Plate") = 0 Then
    If InStr(mn(j, 3), "Chequered") = 0 Or InStr(mn(j, 3), "Chequered") = 0 Then
Mỗi câu là 1 cái Or, nhưng 2 vế của Or nó như thế nào?

Các ô lỗi lại là lỗi của hàm Vlookup. Khi gán hàm Vlookup cho ô thì những con số 543, 1042 lấy từ đâu ra vậy?
 
Upvote 0
Cám ơn tác giả của code (Anh @Hoàng Tuấn 868 ), vì code này em sửa code của anh.
Và cám ơn anh @HUONGHCKT , anh @BuiQuangThuan và thầy @ptm0412 đã hướng dẫn cho em.
Vì em không rành căn bản code VBA, nên em chỉnh code tùm lum, nên mới xảy ra cơ sự.
Mong các anh thông cảm.
Mong nhận được sự giúp đỡ.
À, mà chổ thầy Mỹ chỉ, em chỉnh lại như sau(Theo anh @Hoàng Tuấn 868 chỉ ) là:
Mã:
If InStr(mn(j, 3), "Steel Plate") <> "" And InStr(mn(j, 3), "Steel Plate") = 0 Then
                 If InStr(mn(j, 3), "Chequered") <> "" And InStr(mn(j, 3), "Chequered") = 0 Then
Mong thầy Mỹ bỏ qua.
 
Upvote 0
Upvote 0
Vậy thì sao hả thầy??? Vậy bỏ đi hả thầy????
 
Upvote 0
Web KT

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

Back
Top Bottom