基于颜色和值获取-编译但没有输出

如何解决基于颜色和值获取-编译但没有输出

我正在处理一个动态工作表，该工作表的内容的总行数和列数都会发生变化。

我想做的是，使活动单元格遍历工作表。它从具有内容的最后一列开始（我在这里使用UsedRange），从第七行一直到最后一行（不留空白）。

当1）活动单元的颜色填充为索引16或36时； 2）活动单元格没有值，该单元格将获取存储在匹配行E中的值。

到达E列时循环将结束（我还没走那么远）。

我将在下面附上我的代码，以获取所有可能的帮助，因为它符合要求，但不会返回任何结果...再次感谢您！

Sub catchCurrentAutomated()

    Dim column As Integer
    Dim row As Integer
    Dim Cell As Range

    row = 7
    column = ActiveSheet.UsedRange.Columns.Count
    Set Cell = ActiveCell

      While range("A" & row) <> ""

        If Cell.Interior.ColorIndex = 16 And _
           IsEmpty(Cell.Value) = True Then

        Cell.Value = Cells(ActiveCell.row,"E").Value

        ElseIf Cell.Interior.ColorIndex = 36 And _
           IsEmpty(Cell.Value) = True Then

        Cell.Value = Cells(ActiveCell.row,"E").Value

        End If

        row = row + 1
        column = column - 1

      Wend

End Sub

解决方法

类似的事情应该起作用（未经测试）

Sub catchCurrentAutomated()

    Dim col As Long '<< use Long not Integer
    Dim row As Long
    Dim c As Range,ws As Worksheet,lr As Long,indx

    Set ws = ActiveSheet
    col = ws.UsedRange.Columns.Count
    lr = ws.Cells(Rows.Count,1).End(xlUp).row  'last occupied cell in ColA
    
    Do While col > 5
        For row = 7 To lr
            With ws.Cells(row,col)
                indx = .Interior.Color.Index
                If (indx = 16 Or indx = 36) And Len(.Value) = 0 Then
                    .Value = ws.Cells(row,"E").Value
                End If
            End With
        Next row
        col = col - 1 'next column to left
    Loop

End Sub