更改输出值范围M2:V2不符合要求

问题描述 投票:0回答:1

请帮忙,如何将目标结果更改为仅在 M2:V2 范围内。

Private Sub CommandButton2_Click()
    Dim rng As Range, j As Variant
    Dim StartV As Long, EndV As Long, i As Long
    Dim k() As Long, Last_Row As Long

    ' Clear contents of the target range
    ActiveSheet.Range("M2:M" & Range("M3").End(xlDown).Row).ClearContents
    Last_Row = Range("A2").End(xlUp).Row
    'Last_Row = Range("A2").End(xlRight).Row
    ReDim k(0)

    ' Set range to B2:K2
    Set rng = Range("B2:K2")
    StartV = Range("B2")
    EndV = Range("K2")
    StartV = 0
    EndV = 9
    For i = StartV To EndV
        On Error Resume Next
        j = Application.Match(i, rng, 0)
        If IsError(j) Then
            k(UBound(k)) = i
            ReDim Preserve k(UBound(k) + 1)
        End If
    Next i

    ' Output the missing values to M2:V2
    Range("M2") = "Resul Missing values"
    
Range("M2:V" & UBound(k) + 1) = Application.Transpose(k)

   
End Sub
excel vba excel-2010
1个回答
0
投票

检索并复制缺失值

enter image description here

Private Sub CommandButton2_Click()
    
    ' Define constants.
    Const START_NUMBER As Long = 0
    Const END_NUMBER As Long = 9
    Const DISPLAY_MESSAGE As Boolean = True
    
    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    ' Reference the source range.
    Dim srg As Range: Set srg = ws.Range("B2:K2")
    
    ' Reference the first (left-most) destination cell...
    Dim dcell As Range: Set dcell = ws.Range("M2")
    ' ... and clear the contents in the same row from this cell
    ' to the last (right-most) worksheet cell.
    dcell.Resize(, ws.Columns.Count - dcell.Column + 1).ClearContents
    
    ' Calculate the maximum number of destination cells (missing numbers)...
    Dim dcMax As Long: dcMax = END_NUMBER - START_NUMBER + 1
    ' ... and define a 1D one-based array of this size.
    Dim dArr() As Variant: ReDim dArr(1 To dcMax)
    
    ' Declare additional variables.
    Dim scIndex As Variant, dcCount As Long, Number As Long
    
    ' Loop through the numbers and write each number missing
    ' in the source range to the array.
    For Number = START_NUMBER To END_NUMBER
        ' Attempt to retrieve the current number's column index (position)
        ' in the source range.
        scIndex = Application.Match(Number, srg, 0)
        ' Note that the 'scIndex' variable is redundant. You might as well
        ' replace it in the next line with the above expression's right side!
        If IsError(scIndex) Then ' is missing (error value)
            dcCount = dcCount + 1 ' next array element (missing number)
            dArr(dcCount) = Number ' write
        'Else ' is not missing (column index); do nothing
        End If
    Next Number
    
    ' Write the values from the array to the destination range whose size
    ' is defined by the number of elements ('dcCount') written to the array..
    If dcCount > 0 Then dcell.Resize(, dcCount).Value = dArr
    ' Note how it doesn't matter that the array is probably bigger ('dcMax')!
    
    ' Inform.
    If DISPLAY_MESSAGE Then
        Select Case dcCount
            Case 0
                MsgBox "No missing numbers found in range ""'" _
                    & ws.Name & "'!" & srg.Address(0, 0) & """!", vbExclamation
            Case dcMax
                MsgBox "All " & dcMax & " numbers were missing in range ""'" _
                    & ws.Name & "'!" & srg.Address(0, 0) & """!", vbInformation
            Case Else
                MsgBox dcCount & " number" & IIf(dcCount = 1, "", "s") _
                    & " were missing in range ""'" _
                    & ws.Name & "'!" & srg.Address(0, 0) & """!", vbInformation
        End Select
    End If
        
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.