| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1205 人关注过本帖, 1 人收藏
标题:VB 找出两个文本框 不同内容
只看楼主 加入收藏
yww595
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2021-8-10
结帖率:60%
收藏(1)
已结贴  问题点数:4 回复次数:6 
VB 找出两个文本框 不同内容
文本框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中


搜索更多相关主题的帖子: 文本框 不同 text1 内容 VB 
2022-08-23 18:36
约定的童话
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:56
帖 子:246
专家分:1442
注 册:2021-8-1
收藏
得分:2 
你这是要做BOM比对吗?
2022-08-23 21:33
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1934
专家分:3012
注 册:2009-12-22
收藏
得分:2 
可以这样搞,text1中的字符串全部读取(切分为数组最好不过),另一个text2中的字符串逐行读取,进行比较。

大致的代码像这样:

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

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2022-08-24 05:02
yww595
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2021-8-10
收藏
得分:0 
回复 2楼 约定的童话
文本内容做分析,找出不同内容
2022-08-24 12:47
William1949
Rank: 3Rank: 3
等 级:新手上路
威 望:8
帖 子:111
专家分:0
注 册:2009-3-17
收藏
得分:0 
程序代码:
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编辑过]

2022-08-27 10:43
William1949
Rank: 3Rank: 3
等 级:新手上路
威 望:8
帖 子:111
专家分:0
注 册:2009-3-17
收藏
得分:0 
图片附件: 游客没有浏览图片的权限,请 登录注册
2022-08-27 10:45
William1949
Rank: 3Rank: 3
等 级:新手上路
威 望:8
帖 子:111
专家分:0
注 册:2009-3-17
收藏
得分:0 
我用3万多的数据量,测试。用时,300多毫秒
图片附件: 游客没有浏览图片的权限,请 登录注册

2022-08-27 10:47
快速回复:VB 找出两个文本框 不同内容
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.042323 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved