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

问题描述 投票:0回答:1
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位置的角色。

excel vba loops autofilter
1个回答
0
投票

如果你不想直接在带有ArrayFormula的Excel中这样做,那么VBA会想要使用Range Areas:

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

© www.soinside.com 2019 - 2024. All rights reserved.