这个应该只能用VBA来实现,我是不知道有什么可以判断格式的公式.
你这个需要判断单元格格式,单元格内单独字符的格式(字体颜色).
写了个大致VBA代码:
Sub 提取彩色字符() '提取彩色字符到下一列Dim rng As Range
Dim cel As Range
Dim i, ii, r As Integer
Dim s As String
On Error GoTo Canceled
Set rng = Application.InputBox("选择或输入区域(单列等整列或区域,选整列耗时长):" & vbCr & "注意:此操作不能撤销,请先保存文件.", "提取彩色字符", Selection.Address, , , , , 8)
On Error GoTo 0
If rng.Rows.Count > 10000 Then If MsgBox("选择的行数超过10000,可能需要较长时间(最多可能3-5分钟)." & vbCr & "是否继续?", vbYesNo + vbQuestion, "确认") = vbNo Then Exit Sub
Debug.Print "处理区域: " & vbTab & rng.Address & vbCr & "区域行数: " & vbTab & rng.Rows.Count & vbCr & Time() & vbTab & "处理数据中,请稍候..."
Application.ScreenUpdating = False
'两个for方案
'For i = 1 To rng.End(xlDown).Row '仅处理第一区域有内容的单元格
For i = rng.Row To rng.Row + rng.Rows.Count - 1 '处理选中所有单元格,不论是否有内容
If Not IsEmpty(Cells(i, rng.Column)) Then
s = ""
Set cel = Cells(i, rng.Column)
If IsNull(cel.Font.Color) Then '检查颜色代码:0:黑色,255:红色,null:混合
For ii = 1 To cel.Characters.Count
If cel.Characters(ii, 1).Font.Color > 0 Then
s = s & cel.Characters(ii, 1).Text
End If
Next
Cells(i, rng.Column + 1) = s
End If
Else
Cells(i, rng.Column + 1).Clear '清理空白单元格对应的结果单元格,不需要可以注释掉
End If
If i Mod 10000 = 0 Then Debug.Print Time() & vbTab & i & "(" & FormatPercent(i / rng.Rows.Count, 1) & ")"
DoEvents
Next
Debug.Print Time() & vbTab & "数据处理完成."
Application.ScreenUpdating = True '恢复屏幕显示刷新
Canceled:
End Sub
打开VBA编辑器(ALT+F11),粘贴过去,运行宏,效果如下:
温馨提示：答案为网友推荐，仅供参考
第1个回答 2019-03-25
这个如果用VBA就很简单了：
在工作表名称上右键----查看代码，弹出VBA编辑窗口，
在左侧任意位置右键----插入---模块：
把下面的代码粘贴到右侧：
Sub 提取红色字符()
For n = 2 To [a65536].End(3).Row
For i = 1 To Len(Cells(n, 1))
If Cells(n, 1).Characters(Start:=i, Length:=1).Font.ColorIndex = 3 Then
k = k & Mid(Cells(n, 1), i, 1)
End If
Next
Cells(n, 2) = k: k = ""
Next
End Sub
最后效果：
提取前：
提取后：
如果改变数据、目标列，请改变相应代码
如何数据在其他列的话 需要改哪个代码呢
追答把你的表截图过来，告诉你怎么修改
第2个回答 2019-03-25
写代码才能够实现
相似回答