写一个excel宏,检验单元格中内容合法性

一块砖头 · 发表于 2024-4-27 06:33

本帖最后由一块砖头于 2024-4-28 10:21 编辑

要求
1.判断A2:A6单元格中所有数字的前面2个字都是旷工,迟到,早退,请假之一,后面2个字都是标次
2.如果单元格里面的内容是无记录或者无备注则默认正确
3.测试表格中有个reset方法,请将代码写在reset方法开头,要求在运行reset方法时先检验单元格合法性,所有单元格都合法则继续运行reset方法,不合法则弹窗显示有哪些单元格不合法

不知道人名的长度和可能会出现的人名,不知道单元格中会有几个数字,要求所有数字的前后都要检验
具体案例我放在测试表格里面了,A2和A4不合法,其余合法

测试文件,密码52pj
https://wwp.lanzoup.com/i5CD51wn6qva

zjg121 · 发表于 2024-4-27 06:33

[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

zjg121 · 发表于 2024-4-27 09:45

[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
      
    ' 创建一个正则表达式对象
    Set regex = CreateObject("VBScript.RegExp")
      
      
    ' 设置正则表达式模式，匹配一个或多个连续的数字
    regex.Pattern = "\d+"
    regex.Global = True ' 设置全局匹配，以找到所有匹配项
      
    ' 执行匹配并获取匹配项集合
    Set matchCollection = regex.Execute(str)
    For hang = 1 To 6
        ' 设置要搜索的字符串
        str = Sheets(1).Cells(hang, 1)
        If str <> "" And str <> "无记录" And str <> "无备注" Then
            ' 遍历匹配项集合
            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)
                    If (pre = "旷工" Or pre = "早退" Or pre = "请假" Or pre = "迟到") And subb = "标次" Then
                    Else
                        Sheets(1).Cells(7 + i, 1) = "第" & hang & "行错误""数字位置: " & position & ", 长度: " & length & ", 数字: " & pre & match.Value & subb
                        Exit Sub
                    End If
                Next i
            Else
                Sheets(1).Cells(7 + i, 1) = "第" & hang & "行错误:无数字"
                Exit Sub
            End If
        Else
            Sheets(1).Cells(8 + i, 1) = "第" & hang & "行错误:" & str
            Exit Sub
        End If
    Next hang
    Sheets(1).Cells(8, 1) = ""
        
    ' 下面写reset内容
    Dim ws As Worksheet
    Dim cell As Range
    Set ws = ThisWorkbook.Sheets("Sheet1") '将"Sheet1"替换为你要操作的表格的名称
    
    For Each cell In ws.Range("A2:A6")
        cell.Value = "无记录"
    Next cell
End Sub

zjg121 · 发表于 2024-4-27 09:50

hang= 2 to 6

zjg121 · 发表于 2024-4-27 11:03

[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
      
    ' 创建一个正则表达式对象
    Set regex = CreateObject("VBScript.RegExp")
      
      
    ' 设置正则表达式模式，匹配一个或多个连续的数字
    regex.Pattern = "\d+"
    regex.Global = True ' 设置全局匹配，以找到所有匹配项
      
    
    For hang = 2 To 6
        ' 设置要搜索的字符串
        str = Sheets(1).Cells(hang, 1)
        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)
                    If (pre = "旷工" Or pre = "早退" Or pre = "请假" Or pre = "迟到") And subb = "标次" Then
                    Else
                        Sheets(1).Cells(8, 1) = "第" & hang & "行错误""数字位置: " & position & ", 长度: " & length & ", 数字: " & pre & match.Value & subb
                        Exit Sub
                    End If
                Next i
            Else
                Sheets(1).Cells(8, 1) = "第" & hang & "行错误:无数字"
                Exit Sub
            End If
        Else
            Sheets(1).Cells(8, 1) = "第" & hang & "行错误:" & str
            Exit Sub
        End If
    Next hang
    Sheets(1).Cells(8, 1) = ""
        
    ' 下面写reset内容
    Dim ws As Worksheet
    Dim cell As Range
    Set ws = ThisWorkbook.Sheets("Sheet1") '将"Sheet1"替换为你要操作的表格的名称
    
    For Each cell In ws.Range("A2:A6")
        cell.Value = "无记录"
    Next cell
End Sub

zjg121 · 发表于 2024-4-27 11:05

一块砖头 · 发表于 2024-4-28 01:42

本帖最后由一块砖头于 2024-4-28 01:43 编辑

zjg121 发表于 2024-4-27 09:45
[mw_shl_code=text,true]Sub Reset()
Dim str As String
Dim regex As Object

不好意思可能是我没有说清楚,需要可以指定检验单元格的位置,比如可以改成J6:J15.再就是麻烦将错误信息用MsgBox一次性全部进行弹窗显示
改完之后能用的话我这边可以把悬赏加到100

zjg121 · 发表于 2024-4-28 07:10

sheet2工作表里面设置一下。

一块砖头 · 发表于 2024-4-28 10:12

zjg121 发表于 2024-4-28 07:12
[mw_shl_code=text,true]Sub Reset()
Dim str As String
Dim regex As Object

再改最后一次,在代码里面决定检验哪些单元格(比如我可以直接填写A5:K6).因为在实际运用中我这边需要检验的是H6:H26,H29:H51,H54,H74,且不能用其他表或者单元格做中转.再就是请用比如A2来表示哪个单元格不合法
同样的还是怪我没有表达清楚,这次改完我给120个币

一块砖头 · 发表于 2024-4-28 10:21

一块砖头发表于 2024-4-28 10:12
再改最后一次,在代码里面决定检验哪些单元格(比如我可以直接填写A5:K6).因为在实际运用中我这边需要检验 ...

不用了,我这边已经解决了

帐号		自动登录	找回密码
密码			注册[Register]

[其他求助] 写一个excel宏,检验单元格中内容合法性

最佳答案

免费评分