创建特定宏

Question

我正在尝试使用Excel 2007为我收集的一些数据创建一个宏。我需要宏做什么，搜索一个列，并找到一定数量的连续零（60），如果有60个连续零删除它们。任何意见或帮助将非常感激！

Answer 1

虽然我有一种感觉，你会在运行此之后改变要求......

选择所有你想要看细胞中，然后运行该代码：

Option Explicit 

Sub deleteConsecutiveZeros() 
    Dim rng As Excel.Range 
    Dim countZeros As Long 
    Dim lastCellRow As Long 
    Dim iCurrentRow As Long 

    Set rng = Selection 
    lastCellRow = rng.Cells.SpecialCells(xlCellTypeLastCell).Row 
    For iCurrentRow = lastCellRow To 1 Step -1 
     If (countZeros >= 60) Then 
      ActiveSheet.Range(rng.Cells(iCurrentRow + 59, 1).Address, rng.Cells(iCurrentRow, 1).Address).EntireRow.Delete 
      countZeros = 0 
     End If 

     If (rng.Cells(iCurrentRow, 1).Value = 0 And rng.Cells(iCurrentRow, 1).Text <> vbNullString) Then 
      countZeros = countZeros + 1 
     Else 
      countZeros = 0 
     End If 
    Next 
End Sub 

Answer 2

是这是你正在尝试的？

LOGIC：

1. 过滤器上的标准
2. 存储在一个变量
3. 删除 “$”，它的Excel在地址自动将上可见单元格地址的范围
4. 检查可见单元格地址是否类似“2：2”或“2：2,5：64”
5. 找到开始行和结束行之间的区别
6. 如果差值> =说60，则清除内容。

CODE

Option Explicit 

Sub Sample() 
    Dim ws As Worksheet 
    Dim lRow As Long, times As Long, Col As Long, i As Long 
    Dim rRange As Range 
    Dim addr As String, MyArray() As String, tmpAr() As String, num As String 

    '~~> Change these as applicable 
    Set ws = ThisWorkbook.Sheets("Sheet1") '<~~ Sheet1 
    Col = 1         '<~~ Col A 
    num = "0"        '<~~ Number to replace 
    times = 60        '<~~ Consecutive Cells with Numbers 

    '~~> Don't change anything below this 
    With ws 
     lRow = .Range(ReturnName(Col) & .Rows.Count).End(xlUp).Row 

     Set rRange = .Range(ReturnName(Col) & "1:" & ReturnName(Col) & lRow) 

     '~~> Remove any filters 
     .AutoFilterMode = False 

     '~~> Filter, offset(to exclude headers) 
     With rRange 
      .AutoFilter Field:=1, Criteria1:="=" & num 
      '~~> get the visible cells address 
      addr = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Address 
     End With 

     '~~> Remove any filters 
     .AutoFilterMode = False 

     addr = Replace(addr, "$", "") 

     '~~> Check if addr has multiple ranges 
     If InStr(1, addr, ",") Then 
      MyArray = Split(addr, ",") 

      '~~> get individual ranges 
      For i = LBound(MyArray) To UBound(MyArray) 
       tmpAr = Split(MyArray(i), ":") 

       '~~> If difference is >= times then clear contents 
       If Val(Trim(tmpAr(1))) - Val(Trim(tmpAr(0))) >= times - 1 Then 
        .Range(ReturnName(Col) & Trim(tmpAr(0)) & ":" & _ 
        ReturnName(Col) & Trim(tmpAr(1))).ClearContents 
       End If 
      Next i 
     Else 
      tmpAr = Split(addr, ":") 

      If Val(Trim(tmpAr(1))) - Val(Trim(tmpAr(0))) >= times - 1 Then 
       .Range(ReturnName(Col) & Trim(tmpAr(0)) & ":" & _ 
       ReturnName(Col) & Trim(tmpAr(1))).ClearContents 
      End If 
     End If 
    End With 
End Sub 

'~~~> Function to retrieve Col Names from Col Numbers 
Function ReturnName(ByVal numb As Long) As String 
    ReturnName = Split(Cells(, numb).Address, "$")(1) 
End Function