Question

我目前正在使用一个工作簿，该工作簿使用一行用彩色/填充灰色表示的单元格在两组数据之间进行分隔。工作表的设置方式没有任何真正的结构，但是如果我可以将数据提取到新工作表中，则可以使用其他一些代码对其进行格式化。提取数据的第一步是让我进入第二个数据集，如果我可以选择有色/填充的单元格行，则可以这样做。我试图使用记录功能，并提出了以下代码：

Application.FindFormat.Clear
    Columns("A:A").Select
    With Application.FindFormat.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.14996795556505
        .PatternTintAndShade = 0
    End With
    Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=True).Activate
ActiveCell.Select
End Sub

问题是上述代码激活/选择了没有填充的空白单元格。如果有人能为我提供一些可能的解释，那我将非常感谢。

或者，如果有人对如何在特定列中搜索唯一的填充/彩色单元格然后返回/选择该单元格地址有想法，那将同样有用。

提前感谢您的任何建议！

Answer 1

我倾向于使用自己的方法而不是内置的方式进行操作，因此发现调试起来更容易。并非在所有情况下都是如此，但使用这种方法确实如此。

将此功能放入VBA中的新模块中...

Public Function GetColoredCells(ByVal rngCells As Range) As Range
    Dim objCell As Range, strCells As String

    For Each objCell In rngCells.Cells
        If objCell.Interior.ColorIndex <> xlColorIndexNone Then
            strCells = strCells & "," & Replace(objCell.Address, "$", "")
        End If
    Next

    strCells = Trim(Mid(strCells, 2))

    Set GetColoredCells = rngCells.Range(strCells)
End Function

Public Sub YourRoutineToCopyAndPaste()
    Dim rngCells As Range

    Set rngCells = GetColoredCells(Sheet1.Range("A1:G13"))

    ' From here, you can work with the individual cells that the
    ' GetColoredCells function returned.

    rngCells.Select
End Sub

它不一定能为您提供所需的确切结果，但是您可以通过逻辑做些事情，并且可以证明该方法。我相信您可以继续进行下一步。

Answer 2

这就是我要做的，只需调整rng，然后为MsgBox添加代码

Public Sub FindFilled()

Dim rng As Range
Dim rcell As Range
Set rng = Range("A1:A255")

  For Each rcell In rng.Cells
        If rcell.Interior.ColorIndex <> xlColorIndexNone Then
                MsgBox "Shading in Cell" & rcell.Address ' Do Code Here
                rcell.select
        End If
  Next rcell
End Sub

如何选择列中唯一的填充/彩色单元格？

2 个答案: