简体   繁体   中英

How to loop through every cell in selected columns in VBA and Excel?

I would like to count the colors for each day (column) in selection. How can I loop through every cell in the selected columns? I've already implemented the color check code.

Example:

Ouput:

  • Day 15 has 8 purple and 3 green
  • Day 16 has 8 purple and 1 green

and so on..

在此处输入图片说明

Sub test()
    Dim purpleCounter As Long, greenCounter As Long
    Dim c As Range, r As Range

    ' For each column in the selected area
    For Each c In Selection.Columns
        ' Reset the color counters
        purpleCounter = 0
        greenCounter = 0

        ' For each row (=cell) in the column we're working on cf. the previous loop
        For Each r In c.Rows
            ' If color of the cell matches our value, increment the respective counter
            If r.Interior.Color = 10498160 Then purpleCounter = purpleCounter + 1
            If r.Interior.Color = 7658646 Then greenCounter = greenCounter + 1
        Next r

        ' Print the results to the Immediate window - or replace this section with whatever
        Debug.Print "Day " & c.Rows.Item(1).Value & " has " & purpleCounter & _
            " purple and " & greenCounter & " green."
    Next c
End Sub

在此处输入图片说明

You can also use findformat looped on the complete column, to create a counter, doing the colour checking and the counting.

for example, something along these lines.

With Application.FindFormat.Interior
     .color=vbRed
end with

set r=range("c3:c30").find(what:="*", searchformat:=True)

Then loop until r is nothing, incrementing a counter. When looping r=range("c3:c30").find(what:="*", after:=r, searchformat:=True)

Thanks.

For Next loop

For c = 15 to 17 'check the column num
    For r = 3 to 30 'assuming your last row is 30
       'color check code here
    next r
next c
Dim Cell as Range
For Each Cell in Selection 
    If cell.row = ? Then ' enter code here
    If cell.Column = ? Then ? = Cell.Interior.Color
Next

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM