[已解决]查找缺少数字

clyf · 发表于 2022-1-14 12:34

统计有效和作废号段在头，尾内的缺少数值，写在L列
如第7行头是2251尾是2300，有效号是2253到2254和2256到2258，作废号是2259
那么缺少的就是2251到2252和2255,2257,2260到2300
连续号用-表示，单一号用/表示

见下图及附件，请老师帮忙处理一下，谢谢（数据为模拟数据，行数不定）
截图.jpg

求助.rar (14.05 KB, 下载次数: 4)

excel用户1116 · 发表于 2022-1-14 13:13

这个最佳答案由 excel用户1116 给出，感谢 excel用户1116 的回答。

单击隐藏图章

本帖最后由 excel用户1116 于 2022-1-14 14:02 编辑

求助.zip (24.58 KB, 下载次数: 7)

林木水 · 发表于 2022-1-14 17:21

本帖最后由林木水于 2022-1-14 18:29 编辑

思路：
1.把有效跟作废的内容处理为全部以单个数字组成以/隔开的字符串sr，循环头到尾
2.判断是否在sr存在，如果存在就下一个，如果不存在就说明是缺少号
3.再处理所有缺少号，难点是把所有连续的数字合并成A-B形式，比较薅头发4.行数不定改第7行代码范围
见附件

Sub demo()
On Error Resume Next
'Dim reg As New RegExp
Dim reg As Object
Set reg = CreateObject("vbscript.regexp")
Dim i As Integer, sr, m, mat, j As Integer, arr, hr, brr, z1, z2, fr
arr = Range("a6:b14")
With reg
.Global = True
.Pattern = "\d+\-\d+|\d+"
For i = 1 To UBound(arr)
Set mat = .Execute(Cells(i + 5, "f").Value)
For Each m In mat
If InStr(m, "-") > 0 Then
For j = Val(Mid(m, 1, InStr(m, "-") - 1)) To Val(Mid(m, InStr(m, "-") + 1, Len(m)))
sr = sr & "/" & j
Next j
Else
sr = sr & "/" & m
End If
Next m
sr = sr & "/" & Cells(i + 5, "i").Value
For j = arr(i, 1) To arr(i, 2)
If InStr(sr, j) = 0 Then
hr = hr & "/" & j
If Mid(hr, 1, 1) = "/" Then hr = Mid(hr, 2, Len(hr))
End If
Next j
If InStr(hr, "/") > 0 Then
brr = VBA.Split(hr, "/")
z1 = brr(0)
fr = z1
For j = 0 To UBound(brr)
If j = UBound(brr) - 1 Then
If brr(j + 1) - brr(j) = 1 Then
fr = z1 & "-" & brr(j + 1)
Else

复制代码

clyf · 发表于 2022-1-14 18:06

本帖最后由 clyf 于 2022-1-14 18:14 编辑

林木水发表于 2022-1-14 17:21
思路：
1.把有效跟作废的内容处理为全部以单个数字组成以/隔开的字符串sr，循环头到尾
2.判断是否在sr存 ...

谢谢老师帮助，解决我的问题了，不过有个小问题，，做好的结果应该是1955-1956/1977 您的是1955/1977，没提取出1956

clyf · 发表于 2022-1-14 18:07

excel用户1116 发表于 2022-1-14 13:13
参考！！！

谢谢老师帮助，解决我的问题了，自定义函数，学习了

林木水 · 发表于 2022-1-14 18:30

clyf 发表于 2022-1-14 18:06
谢谢老师帮助，解决我的问题了，不过有个小问题，，做好的结果应该是1955-1956/1977 您的是1955/1977 ...

Sub demo()
On Error Resume Next
'Dim reg As New RegExp
Dim reg As Object
Set reg = CreateObject("vbscript.regexp")
Dim i As Integer, sr, m, mat, j As Integer, arr, hr, brr, z1, z2, fr
arr = Range("a6:b14")
With reg
.Global = True
.Pattern = "\d+\-\d+|\d+"
For i = 1 To UBound(arr)
Set mat = .Execute(Cells(i + 5, "f").Value)
For Each m In mat
If InStr(m, "-") > 0 Then
For j = Val(Mid(m, 1, InStr(m, "-") - 1)) To Val(Mid(m, InStr(m, "-") + 1, Len(m)))
sr = sr & "/" & j
Next j
Else
sr = sr & "/" & m
End If
Next m
sr = sr & "/" & Cells(i + 5, "i").Value
For j = arr(i, 1) To arr(i, 2)
If InStr(sr, j) = 0 Then
hr = hr & "/" & j
If Mid(hr, 1, 1) = "/" Then hr = Mid(hr, 2, Len(hr))
End If
Next j
If InStr(hr, "/") > 0 Then
brr = VBA.Split(hr, "/")
z1 = brr(0)
fr = z1
For j = 0 To UBound(brr)
If j = UBound(brr) - 1 Then
If brr(j + 1) - brr(j) = 1 Then
fr = z1 & "-" & brr(j + 1)
Else
z1 = fr
fr = z1 & "/" & brr(j + 1)
End If
Exit For
End If
If brr(j + 1) - brr(j) = 1 Then
fr = z1 & "-" & brr(j + 1)
Else
z1 = fr & "/" & brr(j + 1)
fr = z1
End If
Next j
Cells(i + 5, "l") = fr
Else
Cells(i + 5, "l") = hr
End If
sr = "": hr = ""
Next i
End With
End Sub

复制代码

用这个，确实有点小问题，第38行代码加一个z1=fr就可以了，你再试试

clyf · 发表于 2022-1-14 18:49

林木水发表于 2022-1-14 18:30
用这个，确实有点小问题，第38行代码加一个z1=fr就可以了，你再试试

谢谢老师帮助，解决我的问题了

		自动登录	找回密码
密码			注册