[Plain Text] 纯文本查看 复制代码 Sub Reset()
Dim str As String
Dim regex As Object
Dim match As Object
Dim matchCollection As Object
Dim position As Integer
Dim length As Integer
Dim i As Integer
' VBScript 或 VBA 中的代码
lie = Sheets(2).Cells(1, 2) + 0
hang1 = Sheets(2).Cells(2, 2) + 0
hang2 = Sheets(2).Cells(3, 2) + 0
m = "错误："
' 创建一个正则表达式对象
Set regex = CreateObject("VBScript.RegExp")
' 设置正则表达式模式，匹配一个或多个连续的数字
regex.Pattern = "\d+"
regex.Global = True ' 设置全局匹配，以找到所有匹配项
' 执行匹配并获取匹配项集合
For hang = hang1 To hang2
' 设置要搜索的字符串
str = Sheets(1).Cells(hang, lie)
If str <> "" And str <> "无记录" And str <> "无备注" Then
' 遍历匹配项集合
Set matchCollection = regex.Execute(str)
cs = matchCollection.Count
If cs <> 0 Then
For i = 1 To cs
Set match = matchCollection.Item(i - 1)
' 获取数字在字符串中的位置（基于0的索引，所以需要加1）
position = match.FirstIndex + 1
' 获取数字的长度
length = match.length
' 输出结果
pre = Mid(str, position - 2, 2)
subb = Mid(str, position + length, 2)
'MsgBox pre & match.Value & subb
If (pre = "旷工" Or pre = "早退" Or pre = "请假" Or pre = "迟到") And subb = "标次" Then
Else
m = m & vbCrLf & "第" & hang & "行错误：" & pre & match.Value & subb
End If
Next i
Else
m = m & vbCrLf & "第" & hang & "行错误:无数字"
End If
Else
End If
Next hang
If Len(m) > 5 Then
MsgBox m
Exit Sub
End If
' 下面写reset内容
Dim ws As Worksheet
Dim cell As Range
Set ws = ThisWorkbook.Sheets("Sheet1") '将"Sheet1"替换为你要操作的表格的名称
For Each cell In ws.Range(Cells(hang1, lie), Cells(hang2, lie))
cell.Value = "无记录"
Next cell
End Sub
| 
发表于 2024-4-27 06:33
|
发表于 2024-4-28 01:42
