目标是在文本框中获取未使用的值,目前我将所有未使用的值都保存在下面,
这就是我想要得到的。
..最后(尚不知道如何提出问题)。
到目前为止我的代码。 它无法识别第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
答案 0 :(得分:1)
将这些值存入工作表之前,将它们收集到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