Question

我是excel VBA的新手，我真的需要有关我正在使用的代码的帮助。非常感谢。

我有一个带有多行文本框的VBA用户窗体。用户将值列表粘贴到其中。然后，将检查这些值，比较A列中的值。然后，比较的输出将显示在Textbox2中。这意味着如果有一些价值观 Textbox1与列A的值相同，它将显示在Textbox2中。将不包括在列A中不存在于Textbox1中的所有值。我正在使用的代码正在运行。但是它的输出是A列中不存在的值，而不是类似的值。

以下是代码：

Private Sub CommandButton1_Click()

Dim TxRay As Variant
Dim Lpray As Variant
Dim oLp As Integer
Dim rng As Range
Dim R As Integer
Dim Ray As Variant
Dim Txt As String
Dim st As Integer
Dim n

TxRay = Split(Replace(TextBox1, Chr(13), ""), Chr(10))
    With Sheets("Orders")
      Set rng = .Range(.Range("A1"), .Range("A" & rows.Count).End(xlUp))
    End With
        Ray = Application.Transpose(rng.value)

    With CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
            Lpray = Array(Ray, TxRay)
    For oLp = 0 To UBound(Lpray)
            st = IIf(oLp = 1, 0, 1)
        For R = st To UBound(Lpray(oLp))
            If Not .Exists(Trim(Lpray(oLp)(R))) Then
                .Add Trim(Lpray(oLp)(R)), ""
                 If oLp = 1 Then
                    Txt = Txt & Trim(Lpray(oLp)(R)) & Chr(10)
                End If
        End If
Next R
Next oLp
End With
With TextBox2
  .MultiLine = True
   .value = Txt
End With
End Sub

Answer 1

我将如何做到这一点：

Private Sub CommandButton1_Click()
    Dim key As Variant, vlist As Variant, v As Variant
    Dim text As String
    Dim dict As Object
    Set dict = getValueDictionary
    vlist = Split(Replace(TextBox1, Chr(13), ""), Chr(10))

    For Each v In vlist
        key = Trim(v)
        If dict.Exists(key) Then text = text & key & Chr(10)
    Next

    With TextBox2
        .MultiLine = True
        .Value = Left(text, Len(text) - 1) ' Removes the last Chr(10)
    End With
End Sub

Function getValueDictionary() As Object
    Dim key As Variant, v As Variant
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    With Sheets("Orders")
        For Each v In .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Value
            key = Trim(v)
            If Not dict.Exists(key) Then dict.Add key, vbNullChar
        Next
    End With
    Set getValueDictionary = dict
End Function

添加了附加功能：删除Textbox1中的值，因为它们已添加到Textbox2值中。

Private Sub CommandButton1_Click()
    Dim key As Variant, vlist As Variant, v As Variant
    Dim text As String
    Dim dict As Object
    Set dict = getValueDictionary
    vlist = Split(Replace(TextBox1, Chr(13), ""), Chr(10))

    For Each v In vlist
        key = Trim(v)
        If dict.Exists(key) Then
            text = text & key & Chr(10)
            TextBox1.text = Replace(TextBox1.text, key & Chr(13) & Chr(10), "")
        End If
    Next

    With TextBox2
        .MultiLine = True
        .Value = Left(text, Len(text) - 1)            ' Removes the last Chr(10)
    End With
End Sub

Answer 2

从此行中删除Not，然后重试：

If Not .Exists(Trim(Lpray(oLp)(R))) Then

将多行文本框值与Excel行值进行比较，然后在textbox2中输出相同的值

2 个答案:

添加了附加功能：删除Textbox1中的值，因为它们已添加到Textbox2值中。