计算每列中的彩色单元格并返回计数

时间:2015-06-24 10:36:51

标签: excel vba excel-vba

我一直在努力寻找一种更简单的方法来返回每列有色细胞的数量。到目前为止我的代码:

UIImageView

如果我有40列这是相当繁琐和缓慢的,有更好的方法来做到这一点(在学习vba时相当新)因此我重复几个对于每个循环并指定列。我需要帮助改进代码或用于返回每列彩色单元格数量的新方法。

2 个答案:

答案 0 :(得分:0)

你的方式很好,但可以改进 -

Sub test()
Dim lastrow As Integer
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim cntclr As Integer
cntclr = 0
For i = 1 To lastrow
    If Cells(i, 1).Interior.Color = vbRed Then
        cntclr = cntclr + 1
    End If
Next
MsgBox (cntclr)
End Sub

如果你想为每一列做这件事,就会这样做并打印结果,只需改变阵列填充的范围

Sub test()
Dim lastrow As Integer
lastrow = Cells(Rows.Count, "A").End(xlUp).Row

Dim lastcol As Integer
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column

Dim arr() As String
ReDim arr(1 To lastcol, 1)
Dim cntClr As Integer
Dim strCol As String
Dim strCnt As String

For j = 1 To lastcol

    cntClr = 0
    For i = 1 To lastrow
    If Cells(i, j).Interior.Color = vbRed Then
        cntClr = cntClr + 1
    End If
    Next
    strCol = "Col " & Chr(64 + j)
    strCnt = Str(cntClr)
    arr(j, 0) = strCol
    arr(j, 1) = cntClr

Next
Range("D1:E" & lastcol) = arr()
End Sub

答案 1 :(得分:0)

使用

Sub errors()

    Dim Sheet1 As String
    Dim mycell As Range
    Dim datecol As Long
    Dim col As Long

    Sheet1 = "different"

    Dim ws As Worksheet, lastrow As Long
    Dim myrng as Range
    Set ws = ActiveWorkbook.Sheets(Sheet1)
    lastrow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
    ' If you think you may have colored cells with no data
    ' Set myrng = ws.UsedRange.Rows
    ' lastrow = myrng(myrng.Count).Row

    Set myrng = ws.Range("B1:B" & lastrow)
    For Each mycell In myrng
        If mycell.Interior.Color = vbRed Then
            datecol = datecol + 1
        End If
    Next mycell

    Debug.Print datecol

End Sub