Question

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

请帮忙。

Answer 1

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

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

<强>试验：

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

此功能将根据您的列号和行号创建一个命名范围。

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

此功能来自How to Convert Excel Column Numbers to Letters

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

Sheet1 Sheet2 Master

如何在Excel中使用集合？

1 个答案: