如何提取红色字体这一行所有的数据到新建工作表中？不要颜色筛选复制粘贴这种方法

Question

如题所述

Answer 1

如果您正在使用Microsoft Excel，并且希望无需手动筛选颜色即可提取红色字体的行，那么您可能需要使用VBA（Visual Basic for Applications）宏来实现这一目标。以下是一个基于VBA的解决方案，通过编程的方式筛选出带有红色字体的单元格所在的行，并将这些行复制到一个新工作表中。
请遵循以下步骤在Excel中创建并运行VBA宏：
1. 按下 `Alt + F11` 打开VBA编辑器。
2. 在VBA编辑器中，选择 `插入` > `模块`，在模块窗口中粘贴以下代码：

Sub ExtractRedFontRows()
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim LastRow As Long, r As Long
Dim SourceRange As Range, Cell As Range

' 设置原始数据工作表和目标工作表
Set SourceSheet = ThisWorkbook.Worksheets("源数据工作表名") ' 替换为源数据工作表的实际名称
Set TargetSheet = ThisWorkbook.Worksheets.Add
TargetSheet.Name = "提取红字数据" ' 新工作表的名称

With SourceSheet
' 确定原始工作表的数据范围
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' 假设数据从第一列开始
Set SourceRange = .Range("A1:Z" & LastRow) ' 假设数据范围为A到Z列，请根据实际情况修改

' 遍历数据范围，查找红色字体
For Each Cell In SourceRange
If Cell.Font.Color = RGB(255, 0, 0) Then ' 检查字体颜色是否为红色
' 将整行数据复制到目标工作表的下一个空白行
r = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row + 1
.Rows(Cell.Row).Copy Destination:=TargetSheet.Rows(r)
End If
Next Cell
End With

MsgBox "红色字体数据提取完成！", vbInformation
End Sub

请确保将代码中的 `"源数据工作表名"` 替换成您实际的工作表名称。
3.关闭VBA编辑器，回到Excel界面。
4. 按下 `Alt + F8` 打开“宏”对话框，选择您所创建的宏，默认应为`ExtractRedFontRows`，点击“运行”。
当您运行此宏时，它会遍历源工作表中的每个单元格，查找字体颜色为红色的单元格，并将整行复制到新创建的工作表中。
注意：VBA宏可以极大地自动化Excel中的许多任务，但使用时请小心。如果您对VBA不熟悉，或者在工作中处理的是重要文件，请确保在尝试之前备份您的数据。此外，此代码不会考虑条件格式设置的颜色，只会考虑直接设置的字体颜色。如果您的红色字体是通过条件格式设置的，那么此代码需要进一步修改。

Answer 2

在Excel中，你可以使用VBA（Visual Basic for Applications）宏来实现提取红色字体这一行所有数据到新建工作表的操作。以下是一个简单的VBA代码示例：

1. 按下`ALT + F11`打开VBA编辑器。
2. 在VBA编辑器中，插入一个新的模块（右键点击项目资源管理器中的VBA项目，选择插入 -> 模块）。
3. 将以下VBA代码复制粘贴到新插入的模块中：

```vba
Sub 提取红色字体数据()
Dim ws As Worksheet
Dim newWs As Worksheet
Dim sourceRow As Range
Dim cell As Range

' 设置源工作表
Set ws = ThisWorkbook.Sheets("你的源工作表名称")

' 创建新工作表
Set newWs = Sheets.Add

' 遍历源工作表的每一行
For Each sourceRow In ws.UsedRange.Rows
' 检查每一行的单元格是否为红色
For Each cell In sourceRow.Cells
If cell.Font.Color = RGB(255, 0, 0) Then ' 红色的RGB值
' 如果找到红色字体，复制整行到新建工作表
sourceRow.Copy newWs.Rows(newWs.Cells(newWs.Rows.Count, "A").End(xlUp).Row + 1)
Exit For
End If
Next cell
Next sourceRow
End Sub
```

4. 替换代码中的"你的源工作表名称"为你实际的源工作表名称。
5. 运行宏（按下`F5`或在菜单中选择运行）。

这个宏会遍历源工作表的每一行，如果发现有红色字体的单元格，就将整行复制到新建工作表中。