如何在Excel中使用集合？

我需要一个VBA代码，用于复制红色单元格内容（其值）、单元格名称和工作表名称，并粘贴到工作簿的新工作表中。 例如，有一个工作簿包含3张工作表。每张纸上都有红色的单元格。我想复制单元格文本、单元格地址和工作表，然后粘贴到新工作表中

---

请在此方面提供帮助。

这将满足您的需要。只需使用简单的循环，首先通过工作表，然后是行，然后是列

它将遍历工作簿中的所有工作表，排除主工作表，检查单元格的内部颜色，并向主工作表报告工作表、地址、值、行和列的内容

测试：

Sub ColorChecker()

Dim lastRow As Long
Dim lastCol As Long
Dim ws As Worksheet
Dim masterSheet As String
Dim mRow As Long
Dim lRow As Long
Dim lCol As Long

mRow = 2
masterSheet = "Master"  'Set the name of the Master Sheet

    For Each ws In Worksheets
        If ws.Name <> masterSheet Then

            lastRow = Sheets(ws.Name).Range("A" & Rows.Count).End(xlUp).row
            lastCol = Sheets(ws.Name).Cells(1, Columns.Count).End(xlToLeft).Column

            For lRow = 2 To lastRow
                For lCol = 1 To lastCol
                    If Sheets(ws.Name).Cells(lRow, lCol).Interior.ColorIndex = 3 Then
                        Sheets(masterSheet).Cells(mRow, 1) = ws.Name
                        Sheets(masterSheet).Cells(mRow, 2) = LongToRange(lRow, lCol)
                        Sheets(masterSheet).Cells(mRow, 3) = Sheets(ws.Name).Cells(lRow, lCol).Value
                        Sheets(masterSheet).Cells(mRow, 4) = lRow
                        Sheets(masterSheet).Cells(mRow, 5) = lCol

                        mRow = mRow + 1
                    End If
                Next lCol
            Next lRow
        End If
    Next ws
End Sub

此功能来自

---

到目前为止，您尝试了什么？请阅读。您希望在新工作表上的布局是什么？A:图纸名称B:值C:行D:列E:范围？或者类似的？我也会为这篇文章改写你的标题。也许是“如何有条件地测试单元格颜色并报告结果”之类的。

Function LongToRange(row As Long, col As Long) As String

Dim tempRange As String

tempRange = Chr(34) & ConvertToLetter(CInt(col)) & row & Chr(34)
LongToRange = tempRange

End Function

Function ConvertToLetter(iCol As Integer) As String
'FROM support.microsoft.com/kb/833404
   Dim iAlpha As Integer
   Dim iRemainder As Integer
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)
   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If
End Function