Sub Sub_HupChao()
Dim Sh As Worksheet
Dim Rws As Long
For Each Sh In ThisWorkbook.Worksheets
Rws = 9 + Sh.UsedRange.Rows.Count
MsgBox Range("D3:E" & Rws).Address, ,Sh.Name
MsgBox [J3].Resize(Rws).Address
MsgBox [L3].Resize(Rws).Address
Next Sh
End Sub
Chả biết học đâu có cặp dấu { }. Xóa đi thử xem
{ } là mảng. [ ] là evaluate. Code của thớt sẽ tạo ra mảng 1 dòng 1 cột.
Code ai đó viết cho thớt, dự bị là nhiều sheets (xem giải thích về mảng ở trên).
Tôi biết. Ý tôi là ai chỉ/ dạy/ làm mẫu cách này (GPE 10 năm nay không thấy).
Thử tham khảo xem sao.
Sub XoaDuLieu()
Dim sh As Worksheet, lr As Long, i As Long, arr
Set sh = ThisWorkbook.Sheets("Beginning")
arr = Array(4, 5, 10, 12)
lr = sh.Cells(Rows.Count, 4).End(xlUp).Row
With sh
For i = 0 To UBound(arr)
.Range(.Cells(3, arr(i)), .Cells(lr, arr(i))).ClearContents
Next i
End With
End SubGPE chỉ thích dùng [ ] như là viết tắt của Evaluate. Và thường chỉ dùng cho Range.
Option Explicit
Sub XoaIssue()
Dim Sh As Variant, lr As Long
Application.ScreenUpdating = False
For Each Sh In Worksheets(Array("Beginning"))
' Sheets(Sh).Select
lr = Sheets("Beginning").Cells(Rows.Count, 4).End(xlUp).Row
Sh.Range("D3:E" & lr + 1).Clear 'Contents
Sh.Range("J3" & lr + 1).Clear
Sh.Range("L3" & lr + 1).Clear
Next Sh
Application.ScreenUpdating = True
End SubThử xem điều gì sẽ xảy ra. Rồi sẽ hiểu vấn đề là như thế nào
Option Explicit
Sub XoaIssue()
Dim Sh As Variant, lr As Long
Application.ScreenUpdating = False
For Each Sh In Worksheets(Array("Beginning"))
' Sheets(Sh).Select
lr = Sheets("Beginning").Cells(Rows.Count, 4).End(xlUp).Row
Sh.Range("D3:D" & lr + 1).Clear 'Contents
Sh.Range("E3:E" & lr + 1).Clear 'Contents
Sh.Range("J3:J" & lr + 1).Clear
Sh.Range("L3:L" & lr + 1).Clear
Next Sh
Application.ScreenUpdating = True
End SubCâu gợi ý bài 12 không hợp lý. Gợi ý phải là "so sánh câu lệnh xóa cột J và cột L ở bài 11 so với bài 1 khác nhau cái gì".
Thấy bạn cũng biết chỉnh lại đoạn code thì nhờ các anh trên đây bàn thêm bàn để bạn hiểu trước, sau thì áp dụng chỉnh sửa sẽ hiểu thêm.
Dim WB As Workbook 'Định nghĩa biến WB
Dim WS As Worksheet 'Định nghĩa biến WS Set WB = ThisWorkbook For Each WS In WB.Worksheets
'Quét qua tất cả các sheet đang có.
Next Debug.Print WS.Name
WS.Range("A1:C10").Value = "Hello"
WS.Range("B1:B5").ClearContents sd.Range("A" & lrd + 1).Resize(r, 16) = md
sd.Range("A" & lrd + 1).Resize(r, 16).Borders.LineStyle = TrueA & Last row = "A" & lrd + 1 = "A" & 100 + 1 = "A101", đó là địa chỉ (1 ô) chứ còn gì nữa?
sd.Range("A" & lrd + 1).Resize(r, 16) = mdsd.Range("A" & lrd + 1).Resize(r, 16).selectSub XoaDuLieu()
Dim sh As Worksheet, lr As Long, i As Long, arr
Set sh = ThisWorkbook.Sheets("Beginning")
arr = Array(4, 5, 10, 12)
lr = sh.Cells(Rows.Count, 4).End(xlUp).Row
If Range("D4").Value <> "" Then 'them vào
With sh
For i = 0 To UBound(arr)
.Range(.Cells(3, arr(i)), .Cells(lr, arr(i))).ClearContents
Next i
End With
End If ' them vào
End Sub
Góp vui: Để đạt được ý bạn như trên có thể tham khảo code sau:
Sub XoaDuLieu()
Dim sh As Worksheet, lr As Long, i As Long, arr
Dim Rng as Range
Set sh = ThisWorkbook.Sheets("Beginning")
arr = Array(4, 5, 10, 12)
With sh
For i = 0 To UBound(arr)
lr = sh.Cells(Rows.Count, i).End(xlUp).Row ' tìm dong cuôi cua côt đinh xóa
If lr=4 then ' Kiêm tra xem cột định xóa có dư liêu không? nếu có thì gom lại
If Rng is nothing then
Set Rng =Range(.Cells(3, arr(i)), .Cells(lr, arr(i)))
else
Set Rng=Union(Rng, Range(.Cells(3, arr(i)), .Cells(lr, arr(i)))
end if
end if
Next i
End With
Rng .ClearContents
End SubCode chạy đã đúng ý chưa?
Bên trong cái vòng lặp For...Each thì Sh chính là Sheets(Beginning). Chỗ Sheets("Beginning") bạn chỉ cần dùng Sh
lr = Sheets("Beginning").Cells(Rows.Count, 4).End(xlUp).Row
Trong code này, bạn hấp tấp nên gõ sót:
Code này viết theo trường phái thịnh hành ở GPE, code không sai nhưng trường phái của tôi quan niệm khác:
Union theo Toán Đại Số là phép hội, gộp nhiều nhóm lại với nhau.
Code câu lệnh đó sai. Khi có vòng lặp i:
Kiểm tra xem lúc đang lỗi thì lr bằng bao nhiêu, hoặc tốt nhất là mỗi lần tính lại lr thì lr có giá trị bao nhiêu. Đối chiếu với điều kiện If lr = 4
Đối chiếu với điều kiện If lr = 4 thì sao? Dữ liệu sai hay điều kiện sai? Chỉnh cái gì bây giờ?
Lý thuyết bổ sung:
Trường hợp này Rng là Union 4 range con, nên chỉ khi cả 4 lần lr < 4 thì mới sinh ra lỗi.
If Not Rng Is Nothing Then Rng.ClearContentsCảm ơn Anh đã nhắc nhở. Đúng là tôi có sửa lại code của bạn ấy và do không có file nên cũng không test lại
Dim J as Integer, Col as Integer, Rws as long
For J = 1 to 4
Col = Choose( J , 4 , 5, 10, 12, 19)
Rws = Cells(9999,Col).End(xlup).row +9 'Dòng cuối có dữ liệu của cột đang xét'
'Thêm dòng lệnh kiểm tra Rws >=4 '
Dòng lệnh xóa dữ liệu của cột đang xét
Next JBạn chạy thử code này
Sub XoaDuLieu()
Dim sh As Worksheet, lr As Long, i As Long, arr
Set sh = ThisWorkbook.Sheets("Beginning")
arr = Array(4, 5, 10, 12)
lr = sh.Cells(Rows.Count, 4).End(xlUp).Row
if lr < 3 then lr = 3
With sh
For i = 0 To UBound(arr)
.Range(.Cells(3, arr(i)), .Cells(lr, arr(i))).ClearContents
Next i
End With
End Sub
Sub XoaDuLieu()
Dim sH As Worksheet, lR As Long, i As Long, aColDele
Set sH = ThisWorkbook.Sheets("Beginning")
lR = sH.Cells(sH.Rows.Count, 4).End(xlUp).Row
If lR <= 2 Then Exit Sub ' dong so 2 la header: no data
aColDele = Array("D", "E", "J", "L")
For i = LBound(aColDele) To UBound(aColDele)
sH.Range(aColDele(i) & 3).Resize(lR - 3 + 1).ClearContents
Next i
End SubNgười ta đã xác nhận có code chạy được rồi. Thêm nữa mà chi.
Đúng rồi bác. Dùng cái split cho nó được nhiều
Sub RangeClears(ParamArray cells())
On Error Resume Next
Dim i, lr&, a
For Each a In cells
Select Case TypeName(a)
Case "Range":
For Each i In a.Areas
lr = i.rows.Count
lr = IIf(lr > 1, lr + 2, i.parent.rows.Count - i.row)
lr = i(lr, 1).End(xlUp).row - i.row + 1
If lr > 0 Then i.Resize(lr).ClearContents
Next
End Select
Next
End Sub
Function refCell(Sheetname$, ParamArray cells()) As Range
On Error Resume Next
Dim o As Object, i, r As Range
Set o = ActiveWorkbook.Worksheets(Sheetname)
If Err <> 0 Or o Is Nothing Then
For Each o In ActiveWorkbook.Worksheets
If o.CodeName = Sheetname Then Exit For
Next
End If
For Each i In cells
Select Case TypeName(i)
Case "Range":
If r Is Nothing Then
Set r = o.Range(i.Address)
Else
Set r = Union(r, o.Range(i.Address))
End If
End Select
Next
Set refCell = r
End Function
