Code xóa dữ liệu không chạy. (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

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
463
Được thích
106
Giới tính
Nữ
Em dùng đoạn code này để xóa dữ liệu cột D3 đến E, và cột J, và cột L của sheet Beginning.20231202_145401.jpg
Mà chạy code không thấy chạy ạ.
Mong các anh chỉ giúp em sai chổ nào ạ. Thông cảm em dùng điện thoại, nên chỉ chụp hình.
 
Mã:
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 Sub

Thử code này xem
 
Upvote 0
Mã:
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 Sub

Thử code này xem
Người ta đã xác nhận có code chạy được rồi. Thêm nữa mà chi.
Chỗ Array còn luộm thuộm lắm. Viết gọn hơn:
Dim colTxt
For Each colTxt In Array("D", "E", "J", "L")
' hoặc ... In [ {"D", "E", "J", "L"} ]
' hoặc ... In Split("D, E, J, L", ", ")
' đằng nào cũng ra colTxt là một ký tự (chuỗi)

sH.Range(colTxt & 3 & ":" & colTxt & lR).ClearContents
Next colTxt
 
Upvote 0
Người ta đã xác nhận có code chạy được rồi. Thêm nữa mà chi.
Chỗ Array còn luộm thuộm lắm. Viết gọn hơn:
Dim colTxt
For Each colTxt In Array("D", "E", "J", "L")
' hoặc ... In [ {"D", "E", "J", "L"} ]
' hoặc ... In Split("D, E, J, L", ", ")
' đằng nào cũng ra colTxt là một ký tự (chuỗi)

sH.Range(colTxt & 3 & ":" & colTxt & lR).ClearContents
Next colTxt
Đúng rồi bác. Dùng cái split cho nó được nhiều
 
Upvote 0
@LuuAnh980 Bạn có thể sử dụng thủ tục tổng quát như sau:

Chỉ cần tạo một nút gán macro: 'RangeClears [D3:E3],[J3],[L3]'
Xóa tại trang khác: 'RangeClears [D3:E3],[J3],refCell("Trang tính 1",[D3:E3],[J3],[L3])'
Giới hạn vùng để không xóa dữ liệu phía dưới: [D3:E2000]

1701760501444.png


Sao chép dán thủ tục dưới vào một Module mã:
JavaScript:
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
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT

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

Back
Top Bottom