LuuAnh980
Thành viên thường trực
- Tham gia
- 28/9/22
- Bài viết
- 391
- Được thích
- 67
- 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:
lỗi Subscript out of range ạ.
Code đây ạ:
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)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
