excel - 相互测试变体

目标是在文本框中获取未使用的值，目前，我将所有这些都获取了，下面



这就是我想要得到的。



..最后（尚不知道如何提出问题）。



到目前为止我的代码
它无法识别第21行上的任何匹配项（如果x = y，则match = True）

    Option Explicit
Sub Resources()
    Application.ScreenUpdating = False

    Dim Arr As Variant
    Arr = Range("A2:A10").Value

    Dim varr As Variant
    varr = Application.Transpose(ExtractNumbers(Range("C2:E10")))

    ActiveSheet.TextBox1.Text = "Unused values"

    Dim i As Integer
    i = 1
    Dim x As Variant, y As Variant, z As Variant
    Dim match As Boolean

    For Each x In Arr
        match = False
        For Each y In varr
            If x = y Then match = True
        Next y

        If Not match And x > 0 Then
            ActiveSheet.TextBox1.Text = ActiveSheet.TextBox1.Text & Chr(10) & x
        End If

        i = i + 1
    Next

    Application.ScreenUpdating = True
End Sub
Public Function ExtractNumbers(Target As Range) As Variant
    Dim regEx As Object
    Set regEx = CreateObject("vbscript.regexp")

    Dim regExMatches As Object, regExMatch As Object
    Dim Result As String
    Dim Cell As Range
    For Each Cell In Target
        If Cell.Value <> vbNullString Then
            With regEx
                .Global = True
                .MultiLine = True
                .IgnoreCase = False
                .Pattern = "[0-9]+"
            End With

            Set regExMatches = regEx.Execute(Cell.Value)
            For Each regExMatch In regExMatches
                Result = Result & regExMatch & ", "
            Next regExMatch
        End If
    Next Cell
    ExtractNumbers = Split(Left$(Result, Len(Result) - 1), ", ")
End Function

最佳答案

将这些值存放到工作表之前，请将它们收集到一个vbLF分隔列表中。

Option Explicit

Sub resources()
    Dim i As Long, str As String
    With Worksheets("sheet6")
        'collect the missing
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            If Not CBool(Application.CountIf(.Range("C:E"), .Cells(i, "A").Value)) Then
                str = Chr(10) & .Cells(i, "A").Value & Space(1) & .Cells(i, "B").Value & str
            End If
        Next i

        'put results in merged cell
        If CBool(Len(str)) Then
            str = "unused values" & str
            .Range("F:F").UnMerge
            .Cells(1, "F").Resize(UBound(Split(str, Chr(10))) + 1, 1).Merge
            .Cells(1, "F").WrapText = True
            .Cells(1, "F") = str
        End If
    End With
End Sub

关于excel - 相互测试变体，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/53038066/