Question

Sub Auto_Open()
Application.ScreenUpdating = False

Dim count4u As Long  
Dim count4g As Long  
...

Dim i As Double
i = 4

 count4u = 0
 count4g = 0
 count4t = 0
...

Sheets("data").Select



Do While Cells(i, 3).Value <> ""
 Cells(i, 3).Activate

 If Left(ActiveCell.Value, 3) = "CP1" Then


        If Mid(ActiveCell.Value, 4, 1) = "U" Then
    count4u = count4u + 1

     ElseIf Mid(ActiveCell.Value, 4, 1) = "G" Then
        count4g = count4g + 1

    ElseIf Mid(ActiveCell.Value, 4, 1) = "T" Then
    count4t = count4t + 1

    ElseIf Mid(ActiveCell.Value, 4, 1) = "B" Then
    count4b = count4b + 1

    ElseIf Mid(ActiveCell.Value, 4, 1) = "F" Then
    count4f = count4f + 1

  ElseIf Mid(ActiveCell.Value, 4, 1) = "C" Then
    count4c = count4c + 1
End If

 ...





i = i + 1
Loop

Worksheets("Base").Activate
Range("X6") = count4u
...
Call cp2count


End Sub

我尝试了几种不同的解决方案，一种尝试为每个循环使用a和Range（“C4”，Range（“C4”）。End（xldown））。SpecialCells（xlCellTypeVisible）。另一次，我只是尝试选择带有特殊单元格的单元格（xlcelltypevisible）并按照我的方式循环遍历它。我有一个问题是能够在不使用activecell功能的情况下计算第4 /第5位置的角色。

Answer 1

如果您不想直接在Excel中使用ArrayFormula执行此操作，则VBA会希望使用范围区域：



Dim rToCheck As Range, rArea As Range, rCell AS Range
Dim count4u AS Long, count4 AS Long

count4u = 0
count4g = 0

Set rToCheck = Application.Intersect(ThisWorkbook.Worksheets("data").UsedRange,ThisWorkbook.Worksheets("data").Columns(3).SpecialCells(xlCellTypeVisible))

If Not(rToCheck Is Nothing) Then 'Make sure we have visible cells!
    For Each rArea In rToCheck
        For Each rCell In rArea
            Select Case Left(rCell.Value,4)
                Case "CP1U"
                    count4u = count4u + 1
                Case "CP1G"
                    count4g = count4g + 1
            End Select
        Next rCell
    Next rArea
End If

Worksheets("Base").Cells(6,24) = count4u 'Cells(6,24) is Range("X6")

Set rToCheck = Nothing
Set rArea = Nothing
Set rCell = Nothing

Dim rToCheck As Range, rArea As Range, rCell AS Range Dim count4u AS Long, count4 AS Long count4u = 0 count4g = 0 Set rToCheck = Application.Intersect(ThisWorkbook.Worksheets("data").UsedRange,ThisWorkbook.Worksheets("data").Columns(3).SpecialCells(xlCellTypeVisible)) If Not(rToCheck Is Nothing) Then 'Make sure we have visible cells! For Each rArea In rToCheck For Each rCell In rArea Select Case Left(rCell.Value,4) Case "CP1U" count4u = count4u + 1 Case "CP1G" count4g = count4g + 1 End Select Next rCell Next rArea End If Worksheets("Base").Cells(6,24) = count4u 'Cells(6,24) is Range("X6") Set rToCheck = Nothing Set rArea = Nothing Set rCell = Nothing

计算过滤后的单元格中的字符

1 个答案: