本帖最后由 树洞先生 于 2024-6-25 10:49 编辑
工作中用EXCEL会比较多点，但是也眼馋WPS的有些功能，对VBA也算会用吧，想着用文言一心来折腾折腾，感觉还不错。
用了40万条数据测试下来2.2秒左右。估计还是要看电脑配置吧。
上一波对话图：
最后上测试过的代码，以及更改了一行位置，将单元格设
置为文本这行的位置。权当看看 ，但是真能跑。
处理的问题类型是这种
[Asm] 纯文本查看 复制代码 Private regex As Object ' 静态的正则表达式对象
Private Sub InitializeRegex() ' 初始化正则表达式对象
If regex Is Nothing Then
Set regex = CreateObject("VBScript.RegExp")
regex.Global = True
End If
End Sub
Function CleanStringWithRegex(ByVal inputString As String) As String
InitializeRegex ' 确保 regex 已创建
regex.Pattern = "\s+|^ | $" ' 合并两个替换操作的正则表达式
CleanStringWithRegex = regex.Replace(inputString, " ")
End Function
' ... 其他代码保持不变，但在调用 CleanStringWithRegex 之前确保 InitializeRegex 已被调用 ...
Sub CleanAndFormatAsText_RegexArray()
Dim rng As Range
Dim cellValues() As Variant
Dim outputValues() As Variant
Dim i As Long, j As Long, rowCount As Long, colCount As Long
Dim startTime As Double
startTime = Timer
' 确保用户已经选定了要处理的单元格范围
If TypeName(Selection) <> "Range" Then
MsgBox "请先选择一个单元格范围。", vbExclamation, "未选择范围"
Exit Sub
End If
' 将选定范围赋值给rng变量，并获取其尺寸
Set rng = Selection
rowCount = rng.Rows.Count
colCount = rng.Columns.Count
' 读取数据到数组中
cellValues = rng.Value2
rng.NumberFormat = "@"
' 为输出值创建同样大小的数组
ReDim outputValues(1 To rowCount, 1 To colCount)
' 关闭屏幕更新和计算，以提高性能
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' 在数组中处理数据
For i = 1 To rowCount
For j = 1 To colCount
If Not IsEmpty(cellValues(i, j)) Then
outputValues(i, j) = CleanStringWithRegex(CStr(cellValues(i, j)))
Else
outputValues(i, j) = ""
End If
Next j
Next i
' 将处理后的数据写回Excel
rng.Value2 = outputValues
' 设置单元格格式为文本
'rng.NumberFormat = "@"
' 恢复屏幕更新和计算
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
' 显示处理完成消息和所用时间
MsgBox "选定范围内的异常字符已被清理，操作完成。" & vbCrLf & _
"所用时间： " & FormatNumber(Timer - startTime, 2) & " 秒", vbInformation, "处理完成"
End Sub | 
发表于 2024-6-24 18:53
|
发表于 2024-6-25 10:32
