文本框text1 内容
2011-1-1
2011-1-2
2011-1-3
……
文本框text2 内容
2011-1-1
2011-1-2
2011-1-4
2011-1-5
……
找出这两个文本框text1 text2 不同内容放入text3中

你这是要做BOM比对吗？

可以这样搞，text1中的字符串全部读取（切分为数组最好不过），另一个text2中的字符串逐行读取，进行比较。

大致的代码像这样：

str = "645756845633457567575442" 
appoint ="33"  '被查找的字符串
pos=InStr(str,appoint)
If  pos > 0 then
MsgBox  "存在字符串"
else
MsgBox "不存在字符串"
End if

文本内容做分析，找出不同内容

Option Explicit

Private Sub Command1_Click()
    Dim iCount1     As Long, iCount2    As Long, iStrCount1 As Long, iStrCount2 As Long
    Dim iIndex1()   As Long, iIndex2()  As Long
    Dim iStr1()     As String, iStr2()  As String
    Dim TTT         As Single
    
    iStr1() = Split(Text(0).Text, vbCrLf)
    iStrCount1 = UBound(iStr1)
    
    iStr2() = Split(Text(1).Text, vbCrLf)
    iStrCount2 = UBound(iStr2)

    TTT = Timer
    Call NotEqual(iStrCount1, iStr1(), iStrCount2, iStr2(), iCount1, iIndex1(), iCount2, iIndex2())
    
    Label1.Caption = "数组 1 总数 = " & iStrCount1 + 1 & "，  不相同的项 = " & iCount1 + 1 & vbCrLf & _
    "数组 2 总数 = " & iStrCount2 + 1 & "，  不相同的项 = " & iCount2 + 1 & vbCrLf & _
    "耗时 = " & (Timer - TTT) * 1000 & " ms"
    
    Call ToList(List1, iCount1 + 1, iStr1(), iIndex1())
    Call ToList(List2, iCount2 + 1, iStr2(), iIndex2())
    
    Erase iIndex1(), iIndex2(), iStr1(), iStr2()
End Sub

Private Sub NotEqual(ByVal ArrCount1 As Long, ByRef Arr1() As String, ByVal ArrCount2 As Long, ByRef Arr2() As String, ByRef NotEqualCount1 As Long, ByRef NotEqualIndex1() As Long, ByRef NotEqualCount2 As Long, ByRef NotEqualIndex2() As Long)
    Dim Ind1        As Long, Ind2           As Long, P As Long
    Dim iPos1()     As Long, iPos2()        As Long
    Dim tempArr1()  As String, tempArr2()   As String

    tempArr1() = Arr1()
    tempArr2() = Arr2()
    
    Call InitArray(ArrCount1, iPos1())
    Call ShellSort_String(ArrCount1, tempArr1(), iPos1())
    
    Call InitArray(ArrCount2, iPos2())
    Call ShellSort_String(ArrCount2, tempArr2(), iPos2())
    
    ReDim NotEqualIndex1(ArrCount1) As Long, NotEqualIndex2(ArrCount2) As Long
    NotEqualCount1 = -1
    NotEqualCount2 = -1
    Do
        If tempArr1(Ind1) < tempArr2(Ind2) Then
            NotEqualCount1 = NotEqualCount1 + 1
            NotEqualIndex1(NotEqualCount1) = iPos1(Ind1)
            Ind1 = Ind1 + 1
        ElseIf tempArr1(Ind1) > tempArr2(Ind2) Then
            NotEqualCount2 = NotEqualCount2 + 1
            NotEqualIndex2(NotEqualCount2) = iPos2(Ind2)
            Ind2 = Ind2 + 1
        Else
            Ind1 = Ind1 + 1
            Ind2 = Ind2 + 1
        End If
        If Ind1 > ArrCount1 Then
            For P = Ind2 To ArrCount2
                NotEqualCount2 = NotEqualCount2 + 1
                NotEqualIndex2(NotEqualCount2) = iPos2(P)
            Next
            Exit Do
        End If
        If Ind2 > ArrCount2 Then
            For P = Ind1 To ArrCount1
                NotEqualCount1 = NotEqualCount1 + 1
                NotEqualIndex1(NotEqualCount1) = iPos1(P)
            Next
            Exit Do
        End If
    Loop
    Call ResetArray(NotEqualCount1, ArrCount1, NotEqualIndex1())
    Call ResetArray(NotEqualCount2, ArrCount2, NotEqualIndex2())
    Erase tempArr1(), tempArr2(), iPos1(), iPos2()
End Sub

Private Sub InitArray(ByVal Length As Long, Arr() As Long)
    Dim P As Long
    ReDim Arr(Length) As Long
    For P = 0 To Length
        Arr(P) = P
    Next
End Sub

Private Sub ResetArray(ByVal NewCount As Long, ByVal OldCount, Arr() As Long)
    If NewCount = -1 Then
        Erase Arr()
    Else
        If NewCount < OldCount Then ReDim Preserve Arr(NewCount) As Long
        Call ShellSort_Long(NewCount, Arr())
    End If
End Sub

Private Sub ShellSort_Long(ByVal ArrCount As Long, ByRef Arr() As Long)
    Dim Distance    As Long, iNext As Long, P As Long
    Dim iTemp       As Long
    
    P = ArrCount + 1
    Distance = 1
    While (Distance <= P)
        Distance = 2 * Distance
    Wend
    Distance = Distance / 2 - 1
    While Distance > 0
        iNext = Distance
        While iNext <= ArrCount
            P = iNext
            Do
                If P >= Distance Then
                    If Arr(P) < Arr(P - Distance) Then
                        iTemp = Arr(P)
                        Arr(P) = Arr(P - Distance)
                        Arr(P - Distance) = iTemp
                        P = P - Distance
                    Else
                        Exit Do
                    End If
                Else
                    Exit Do
                End If
            Loop
            iNext = iNext + 1
        Wend
        Distance = (Distance - 1) / 2
    Wend
End Sub

Private Sub ShellSort_String(ByVal ArrCount As Long, ByRef Arr() As String, ByRef Pos() As Long)
    Dim Distance    As Long, iNext As Long, tePos As Long, P As Long
    Dim iTemp       As String

    P = ArrCount + 1
    Distance = 1
    While (Distance <= P)
        Distance = 2 * Distance
    Wend
    Distance = Distance / 2 - 1
    While Distance > 0
        iNext = Distance
        While iNext <= ArrCount
            P = iNext
            Do
                If P >= Distance Then
                    If Arr(P) < Arr(P - Distance) Then
                        iTemp = Arr(P)
                        Arr(P) = Arr(P - Distance)
                        Arr(P - Distance) = iTemp
                        tePos = Pos(P)
                        Pos(P) = Pos(P - Distance)
                        Pos(P - Distance) = tePos
                        P = P - Distance
                    Else
                        Exit Do
                    End If
                Else
                    Exit Do
                End If
            Loop
            iNext = iNext + 1
        Wend
        Distance = (Distance - 1) / 2
    Wend
End Sub

Private Sub ToList(List As ListBox, ByVal Count As Long, Arr() As String, ArrIndex() As Long)
    Dim P   As Long
    With List
        .Clear
        .Visible = False
        For P = 0 To Count - 1
            .AddItem Arr(ArrIndex(P))
        Next
        .Visible = True
    End With
End Sub

[此贴子已经被作者于2022-8-27 10:49编辑过]

我用3万多的数据量，测试。用时，300多毫秒