Question

我使用这个VB脚本来检测excel中缺少的序列号

Sub Missingvalues()
Dim rng As Range
Dim rng1 As Range
Dim StartV As Single, EndV As Single, i As Single, j As Single
Dim k() As Single
Dim WS As Worksheet
ReDim k(0)
On Error Resume Next
Set rng = Application.InputBox(Prompt:="Select a range:", _
Title:="Extract missing values", _
Default:=Selection.Address, Type:=8)
StartV = InputBox("Start value:")
EndV = InputBox("End value:")
On Error GoTo 0
Set WS = Sheets.Add
WS.Range("a:a,c:c,e:e" & rng.Rows.CountLarge).Value = rng.Value
With WS.Sort
    .SortFields.Add Key:=WS.Range("a1,c1,e1"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Range("a:a,c:c,e:e" & rng.Rows.CountLarge)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Set rng1 = WS.Range("a1:a,c1:c,e1:e" & rng.Rows.CountLarge)
For i = StartV To EndV
    On Error Resume Next
    j = Application.Match(i, rng1)
    If Err = 0 Then
        If rng1(j, 1) <> i Then
            k(UBound(k)) = i
            ReDim Preserve k(UBound(k) + 1)
        End If
    Else
        k(UBound(k)) = i
        ReDim Preserve k(UBound(k) + 1)
    End If
    On Error GoTo 0
Next i
ReDim Preserve k(UBound(k) - 1)
WS.Range("b1,d1,f1") = "Missing values"
WS.Range("b2:b,d2:2,f2:f" & UBound(k) + 1) = Application.Transpose(k)
End Sub

但此代码仅适用于一列。我想要这样的多列：

http://imageshack.com/a/img834/9378/6w7s2.jpg

有解决方案吗？

在多列中查找缺失的数字序列 - excel

0 个答案: