小白，交作业了…

周某人就是我

Sub Action()
Dim reg As Object
Dim mat As Object
Dim arr, arr1, arr2
Dim i%, n%, j%
Set reg = Create Object("vbscript.regexp")
arr = Range("A3:I252").Value2
arr1 = Array("A", "B", "C", "D", "E", "F")
arr2 = Array("字符1", "字符2", "字符3", "字符4", "字符5", "字符6")
Application.ScreenUpdating = False
i = 1
Do While arr(i, 6)) <> ""
Select Case arr(i, 6)
Case Is > 2
arr(i, 7) = "文本1"
Case Is > 0
arr(i, 7) = "文本2"
End Select
If InStr(8, arr(i + 1, 4), "C", 0) > 0 Then
Select Case arr(i + 1, 7)
Case Is = "文本3", "文本4"
arr(i + 1, 9) = "文本5"
End Select
ElseIf InStr(8, arr(i + 1, 4), "D", 0) > 0 Then
Select Case arr(i + 1, 7)
Case Is = "文本3", "文本4"
arr(i + 1, 9) = "文本6"
End Select
End If
If InStr(14, arr(i + 2, 4), "-1", 0) > 0 Then
If Len(arr(i + 3, 4)) < 14 Then
Select Case Len(arr(i + 4, 4))
Case Is > 14
arr(i + 3, 4) = Replace(arr(i + 2, 4), "-1", "-2")
Case Is < 14
arr(i + 3, 4) = Replace(arr(i + 2, 4), "-1", "-2")
arr(i + 4, 4) = Replace(arr(i + 2, 4), "-1", "-3")
End Select
End If
ElseIf InStr(14, arr(i + 2, 4), "-2", 0) > 0 Then
Select Case Len(arr(i + 3, 4))
Case Is < 14
arr(i + 3, 4) = Replace(arr(i + 2, 4), "-2", "-3")
End Select
ElseIf InStr(14, arr(i + 2, 4), "-3", 0) > 0 Then
If Len(arr(i + 3, 4)) < 14 Then
Select Case Len(arr(i + 4, 4))
Case Is > 14
arr(i + 3, 4) = Replace(arr(i + 2, 4), "-3", "-2")
Case Is < 14
arr(i + 3, 4) = Replace(arr(i + 2, 4), "-3", "-2")
arr(i + 4, 4) = Replace(arr(i + 2, 4), "-3", "-1")
End Select
End If
End If
If InStr(14, arr(i + 3, 4), "-1", 0) > 0 And Len(arr(i + 4, 4)) < 14 Then
arr(i + 4, 4) = Replace(arr(i + 3, 4), "-1", "-2")
ElseIf InStr(14, arr(i + 3, 4), "-2", 0) > 0 And Len(arr(i + 4, 4)) < 14 Then
arr(i + 4, 4) = Replace(arr(i + 3, 4), "-2", "-3")
ElseIf InStr(14, arr(i + 3, 4), "-3", 0) > 0 And Len(arr(i + 4, 4)) < 14 Then
arr(i + 4, 4) = Replace(arr(i + 3, 4), "-3", "-2")
End If
i = i + 5
Loop

For i = 1 to UBound(arr)
If arr(i, 6) = "" Then Exit For
arr(i, 1) = Date
If arr(i, 7) = "" Then
arr(i, 7) = "文本7"
End If
With reg
.Global =True
.Pattern ="\*\d{1,2}"
Set mat = .Execute(arr(i, 9))
If mat.Count > 0 Then
For n = 0 To mat.Count - 1
arr(i, 9) = .Replace(arr(i, 9), mat(n) & "MM")
Next
End If
For j = 0 to UBound(arr1)
.Pattern =arr1(j)
If .test(arr(i, 9)) Then
arr(i, 9) = .Replace(arr(i, 9), arr2(j))
End If
Next
End With
Next
Set reg = Nothing
Set mat = Nothing
Application.ScreenUpdating = True
Range("A3:I252").Value2 = arr
End Sub

周某人就是我

老师们，看看有什么不足之处可以优化的。
另外请教:
1，Application.ScreenUpdating = False和Application.ScreenUpdating = True分别放在什么位置最好。
2，数组元素多次出现，是否有必要设个变量替代，如 t = arr(i + 2, 4)
3，对于常规数据，正则匹配替换和Instr函数配合Replace函数哪个更高效

周某人就是我

有两处手误:
Setreg应为Set reg
Range(A3:I252).Value2 = arr应为Range("A3:I252").Value2 = arr

周某人就是我

周某人就是我 发表于 2024-1-16 21:15
有两处手误:
Setreg应为Set reg
Range(A3:I252).Value2 = arr应为Range("A3:I252").Value2 = arr

Set reg = Create Object("vbscript.regexp")

周某人就是我

:: L又一处错误
If arr(i, 7) = "" Then
arr(i, 7) = "文本7"
End If     '少了结尾

ykcbf1100

没有附件，这代码也看不出是不是真的好用。

ykcbf1100

你这代码自己都查出这么多问题，上传以前代码有没有调试过啊。

小花鹿

适当的缩进才能方便阅读

周某人就是我

ykcbf1100 发表于 2024-1-17 08:17
你这代码自己都查出这么多问题，上传以前代码有没有调试过啊。

这些代码都是在手机上敲出来的。之前是分段分过程写的，都是在电脑上验证过的。现在揉在一起了，揉在一起就要改许多地方

周某人就是我

没编辑修改完，点保存了，又要等审核了