纯数字数据,3个数字一组,每2组相交,求相交数

[yqlg2000]

各位大哥大姐帮帮忙,急要用到

有一堆纯数字数据,3个数字一组,每2组相交,求相交数

如
3 1 3 7 7 5 6
9 7 9 3 3 1 2
4 2 4 8 8 6 7
9 7 9 3 3 1 2
6 4 6 0 0 8 9
9 7 9 3 3 1 2
2 0 2 6 6 4 5
4 1 4 5 6 0 7
0 7 0 1 2 6 3
5 2 5 6 7 1 8
0 7 0 1 2 6 3
7 4 7 8 9 3 0

....................


第一组:3 1 3 7 7 5 没有相交数,就忽略了
第二组:6 9 7 9 3 3 相交得 9
第三组:1 2 4 2 4 8 相交得 2 4
第四组:8 6 7 9 7 9 相交得 7
.................


其中比较麻烦的是,要以后3个数字的一组为准,如这一组

123 322 相交得 3 2

后一组三个数字是322, 3比2先出现.

还是就是如果有多个相同的数字就取一个,如这组出现二个2,相交就得一个2就可以了.



帮忙看下要什么做,谢谢.

[jhone99]

[Quote=引用 15 楼 yqlg2000 的回复:]
帮我改一下
不要显示
6 9 7 9 3 3->
1 2 4 2 4 8->
8 6 7 9 7 9->
7 9 3 3 1 2->
5 4 1 4 5 6->
0 7 0 7 0 1->
2 6 3 5 2 5->
6 7 1 8 0 7->

只显示
9
2 4
7
3
4 5
7 0
2
7

代码要什么写
[/Quote]

Public Sub Main()
    Const LIST As String = "3 1 3 7 7 5 6 " & _
                           "9 7 9 3 3 1 2 " & _
                           "4 2 4 8 8 6 7 " & _
                           "9 7 9 3 3 1 2 " & _
                           "6 4 6 0 0 8 9 " & _
                           "9 7 9 3 3 1 2 " & _
                           "2 0 2 6 6 4 5 " & _
                           "4 1 4 5 6 0 7 " & _
                           "0 7 0 1 2 6 3 " & _
                           "5 2 5 6 7 1 8 " & _
                           "0 7 0 1 2 6 3 " & _
                           "7 4 7 8 9 3 0"
    Dim aNum() As String
    Dim aDup() As Boolean, lDupCount As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long
    
    aNum = Split(LIST, " ")
    For i = 0 To UBound(aNum) - 5
        ReDim aDup(3 To 5)
        lDupCount = 0
        
        For j = 3 To 5 '循环后3个'
            For k = 0 To 2
                If aNum(i + j) = aNum(i + k) Then '是否与前3个中任意一个相等'
                    aDup(j) = True
                    For l = 3 To j - 1
                        If aNum(i + j) = aNum(i + l) Then '是否已经出现过相同的相等'
                            aDup(j) = False
                            Exit For
                        End If
                    Next
                    
                    If aDup(j) Then
                        lDupCount = lDupCount + 1
                    End If
                End If
            Next
        Next
        
        If lDupCount > 0 Then
'            For j = 0 To 5
'                If j > 0 Then Debug.Print " ";
'                Debug.Print aNum(i + j);
'            Next
'            Debug.Print "->";
            
            For j = 3 To 5
                If aDup(j) Then
                    Debug.Print aNum(i + j) & " ";
                End If
            Next
            Debug.Print
        End If
    Next
End Sub

[king06]

Option Explicit

Private Sub Command1_Click()
    Dim nums As String
    nums = "3 1 3 7 7 5 6 " & _
            "9 7 9 3 3 1 2 " & _
            "4 2 4 8 8 6 7 " & _
            "9 7 9 3 3 1 2 " & _
            "6 4 6 0 0 8 9 " & _
            "9 7 9 3 3 1 2 " & _
            "2 0 2 6 6 4 5 " & _
            "4 1 4 5 6 0 7 " & _
            "0 7 0 1 2 6 3 " & _
            "5 2 5 6 7 1 8 " & _
            "0 7 0 1 2 6 3 " & _
            "7 4 7 8 9 3 0 "
    Debug.Print "相交数:" & Trim(GetCrossNum(nums))
End Sub

Private Function GetCrossNum(ByVal vStr As String) As String
    Dim mString As String
    Dim strOF As String, strSame(2) As String
    Dim i As Long, j As Long, k As Integer
    Dim strTmp As String
    Dim arrTmp() As String
    arrTmp = Split(vStr, " ")
    For i = 0 To UBound(arrTmp)
        If k = 3 Then
            strOF = ""
            strTmp = ""
            For j = i - 3 To i + 2
                strOF = strOF & " " & arrTmp(j)
            Next
            If strSame(0) = "" And strSame(1) = "" And strSame(2) = "" Then
            Else
                If strSame(0) = strSame(1) Or strSame(0) = strSame(2) Then
                    strSame(0) = ""
                Else
                    If strSame(1) = strSame(2) Then
                        strSame(1) = ""
                    End If
                End If
                strTmp = strSame(0) & " " & strSame(1) & " " & strSame(2)
                Debug.Print Trim(strTmp) & "---" & strOF

                mString = mString & IIf(mString = "", Trim(strTmp), " " & Trim(strTmp))
            End If
            i = i + 2
            k = -1
            Erase strSame
        Else
            If i + 3 - k <= UBound(arrTmp) Then
                If i + 5 - k <= UBound(arrTmp) Then
                    For j = i + 3 - k To i + 5 - k
                        If Val(arrTmp(i)) = Val(arrTmp(j)) Then

'                            Debug.Print arrTmp(i)
                            strSame(k) = arrTmp(i)
                            Exit For
                        End If
                    Next
                Else '最后还留不多于6个数
                    For j = i + 3 - k To UBound(arrTmp)
                        If Val(arrTmp(i)) = Val(arrTmp(j)) Then
'                            Debug.Print arrTmp(i)
                            strSame(k) = arrTmp(i)
                            Exit For
                        End If
                    Next
                End If
            Else '最后还留不多余3个数
                Exit For
            End If
        End If
        k = k + 1
    Next
    GetCrossNum = mString
End Function

要不要debug随你自己啊,代码不用保存到什么地方,回去了在CSDN这里来copy不就可以了

[king06]

[Quote=引用 20 楼 king06 的回复:]
要不要debug随你自己啊,代码不用保存到什么地方,回去了在CSDN这里来copy不就可以了
[/Quote]
你把分都给我了,别人的辛劳不是白费了。。。。。。尽管有点得了便宜还卖乖的说

[神马都能聊]

[Quote=引用 21 楼 king06 的回复:]
引用 20 楼 king06 的回复:
要不要debug随你自己啊,代码不用保存到什么地方,回去了在CSDN这里来copy不就可以了

你把分都给我了,别人的辛劳不是白费了。。。。。。尽管有点得了便宜还卖乖的说

[/Quote]
呵呵，我也来凑个热闹。测试了下，10万个字符大概1秒上下可以完成，而在超过30多万个字符时速度下降的厉害。使用byte数组写的，下面写了个字符操作的，似乎byte的快些。

Option Explicit

Private Sub Command1_Click()
        Dim str As String
        str = "3 1 3 7 7 5 6 ," & _
                           "9 7 9 3 3 1 2 ," & _
                           "4 2 4 8 8 6 7 ," & _
                           "9 1 3 3 3 1 2 ," & _
                           "6 4 6 0 0 8 9 ," & _
                           "9 7 9 3 3 1 2 ," & _
                           "2 6 2 6 6 4 5 ," & _
                           "4 1 4 5 6 0 7 ," & _
                           "0 7 0 1 2 6 3 ," & _
                           "5 2 5 6 7 1 8 ," & _
                           "0 7 0 1 2 6 3 ," & _
                           "7 4 7 8 9 3 0 ,"
        Dim i As Long
        
        For i = 0 To 8
            str = str & str
        Next
        
        Debug.Print Len(str)
        
        Dim cross_data As String
        
        cross_data = return_cross_data(str)
        
        Debug.Print cross_data
        Debug.Print Len(cross_data)
End Sub

Private Function return_cross_data(ByRef str As String) As String
        Dim in_data() As String
        Dim in_data_line() As String
        Dim s As String
        
        in_data = Split(str, ",")
        
        Dim iCount As Long
        
        iCount = UBound(in_data)
        
        Dim i As Long
        
        For i = 0 To iCount - 1
            s = s & new_process_line_data(in_data(i)) & vbCrLf
        Next
        
        return_cross_data = s
End Function

Private Function process_line_data(ByVal line As String) As String
        Dim bLine() As Byte
        Dim i As Long
        Dim ii As Long
        Dim iCount As Long
        Dim bNoMatch As Boolean
        Dim s As String
        
        bLine = line
        
        bNoMatch = False
        For i = 0 To 11 Step 4
            For ii = 12 To 20 Step 4
                If (bLine(i) = bLine(ii)) Then
                    bNoMatch = True
                    If Len(s) <> 0 Then
                        s = s & "|" & Chr(bLine(i))
                    Else
                        s = s & line & "->" & Chr(bLine(i))
                    End If
                    Exit For
                End If
            Next
        Next
        If Not bNoMatch Then
            process_line_data = line & "->no match"
        Else
            process_line_data = s
        End If
End Function


Private Function new_process_line_data(ByVal line As String) As String
        Dim bLine() As String
        Dim i As Long
        Dim ii As Long
        Dim iCount As Long
        Dim bNoMatch As Boolean
        Dim s As String
        
        bLine = Split(line, " ")
        
        bNoMatch = False
        For i = 0 To 2
            For ii = 3 To 5
                If (bLine(i) = bLine(ii)) Then
                    bNoMatch = True
                    If Len(s) <> 0 Then
                        s = s & "|" & bLine(i)
                    Else
                        s = s & line & "->" & bLine(i)
                    End If
                    Exit For
                End If
            Next
        Next
        If Not bNoMatch Then
            new_process_line_data = line & "->no match"
        Else
            new_process_line_data = s
        End If
End Function

[神马都能聊]

补充一句，我猜想楼主的数据来源每行可能是分开的，于是就在每行加了个逗号来分割数据。

[舉杯邀明月]

这个应该没难度。

“数据源”如何取得？

[yqlg2000]

数据是不固定的

代码该什么写啊

[帝企鹅已被占用]

搞成数组，loop几下。

[king06]

我来拿这个分吧

Option Explicit

Private Sub Command1_Click()
    Dim nums As String
    nums = "3 1 3 7 7 5 6 " & _
            "9 7 9 3 3 1 2 " & _
            "4 2 4 8 8 6 7 " & _
            "9 7 9 3 3 1 2 " & _
            "6 4 6 0 0 8 9 " & _
            "9 7 9 3 3 1 2 " & _
            "2 0 2 6 6 4 5 " & _
            "4 1 4 5 6 0 7 " & _
            "0 7 0 1 2 6 3 " & _
            "5 2 5 6 7 1 8 " & _
            "0 7 0 1 2 6 3 " & _
            "7 4 7 8 9 3 0 "
    Dim i As Long, j As Long, k As Integer
    Dim arrTmp() As String
    arrTmp = Split(nums, " ")
    For i = 0 To UBound(arrTmp)
        If k = 3 Then
'            Debug.Print "------" '可以用某个符号来区分每组6个数的相交数
            i = i + 3
            k = 0
        Else
            If i + 3 - k <= UBound(arrTmp) Then
                If i + 5 - k <= UBound(arrTmp) Then
                    For j = i + 3 - k To i + 5 - k
                        If arrTmp(i) = arrTmp(j) Then
                            Debug.Print arrTmp(i)
                            Exit For
                        End If
                    Next
                Else '最后还留不多于6个数
                    For j = i + 3 - k To UBound(arrTmp)
                        If arrTmp(i) = arrTmp(j) Then
                            Debug.Print arrTmp(i)
                            Exit For
                        End If
                    Next
                End If
            Else '最后还留不多余3个数
                Exit For
            End If
        End If
        k = k + 1
    Next
End Sub

[yqlg2000]

那个.......

我是说数据是不固定的,下次另外一堆数据的时候,还可以用的程序.

[king06]

我是用nums 作例子的,你用个函数不就可以了

[vbman2003]

给你算法思路，6个数字一组你要根据自己的具体情况拆分

Function GetValue(ByVal pStr As String) As String
    
    Dim i As Long
    Dim lng(9) As Long
    Dim arr    
    arr = Split(pStr, Chr(32))
    For i = 0 To 2
        lng(arr(i)) = lng(arr(i)) + 1
    Next
    For i = 3 To 5
        If lng(arr(i)) > 0 Then
            GetValue = GetValue & arr(i)
            lng(arr(i)) = 0
        End If
    Next
End Function

Private Sub Command1_Click()
       
    Debug.Print GetValue("3 1 3 7 7 5")
    Debug.Print GetValue("6 9 7 9 3 3")
    Debug.Print GetValue("1 2 4 2 4 8")
    Debug.Print GetValue("8 6 7 9 7 9")
    Debug.Print GetValue("1 2 3 3 2 2")

End Sub

[king06]

Private Sub Command1_Click()
    Dim nums As String
    nums = "3 1 3 7 7 5 6 " & _
            "9 7 9 3 3 1 2 " & _
            "4 2 4 8 8 6 7 " & _
            "9 7 9 3 3 1 2 " & _
            "6 4 6 0 0 8 9 " & _
            "9 7 9 3 3 1 2 " & _
            "2 0 2 6 6 4 5 " & _
            "4 1 4 5 6 0 7 " & _
            "0 7 0 1 2 6 3 " & _
            "5 2 5 6 7 1 8 " & _
            "0 7 0 1 2 6 3 " & _
            "7 4 7 8 9 3 0 "
    Debug.Print GetCrossNum(nums)
End Sub

Private Function GetCrossNum(ByVal vStr As String) As String
    Dim mString As String
    Dim i As Long, j As Long, k As Integer
    Dim arrTmp() As String
    arrTmp = Split(vStr, " ")
    For i = 0 To UBound(arrTmp)
        If k = 3 Then
'            Debug.Print "------" '可以用某个符号来区分每组6个数的相交数
            i = i + 3
            k = 0
        Else
            If i + 3 - k <= UBound(arrTmp) Then
                If i + 5 - k <= UBound(arrTmp) Then
                    For j = i + 3 - k To i + 5 - k
                        If arrTmp(i) = arrTmp(j) Then
                            
                            mString = mString & " " & arrTmp(i)
                            Exit For
                        End If
                    Next
                Else '最后还留不多于6个数
                    For j = i + 3 - k To UBound(arrTmp)
                        If arrTmp(i) = arrTmp(j) Then
                        
                            mString = mString & " " & arrTmp(i)
                            Exit For
                        End If
                    Next
                End If
            Else '最后还留不多余3个数
                Exit For
            End If
        End If
        k = k + 1
    Next
    GetCrossNum = mString
End Function

[vbman2003]

以上假设你的数字都是0-9，如果有大于9的数，GetValue中数组变量lng按最大值声明...

[Tiger_Zhao]

Option Explicit

Public Sub Main()
    Const LIST As String = "3 1 3 7 7 5 6 " & _
                           "9 7 9 3 3 1 2 " & _
                           "4 2 4 8 8 6 7 " & _
                           "9 7 9 3 3 1 2 " & _
                           "6 4 6 0 0 8 9 " & _
                           "9 7 9 3 3 1 2 " & _
                           "2 0 2 6 6 4 5 " & _
                           "4 1 4 5 6 0 7 " & _
                           "0 7 0 1 2 6 3 " & _
                           "5 2 5 6 7 1 8 " & _
                           "0 7 0 1 2 6 3 " & _
                           "7 4 7 8 9 3 0"
    Dim aNum() As String
    Dim aDup() As Boolean, lDupCount As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long
    
    aNum = Split(LIST, " ")
    For i = 0 To UBound(aNum) - 5
        ReDim aDup(3 To 5)
        lDupCount = 0
        
        For j = 3 To 5 '循环后3个'
            For k = 0 To 2
                If aNum(i + j) = aNum(i + k) Then '是否与前3个中任意一个相等'
                    aDup(j) = True
                    For l = 3 To j - 1
                        If aNum(i + j) = aNum(i + l) Then '是否已经出现过相同的相等'
                            aDup(j) = False
                            Exit For
                        End If
                    Next
                    
                    If aDup(j) Then
                        lDupCount = lDupCount + 1
                    End If
                End If
            Next
        Next
        
        If lDupCount > 0 Then
            For j = 0 To 5
                If j > 0 Then Debug.Print " ";
                Debug.Print aNum(i + j);
            Next
            Debug.Print "->";
            
            For j = 3 To 5
                If aDup(j) Then
                    Debug.Print aNum(i + j) & " ";
                End If
            Next
            Debug.Print
        End If
    Next
End Sub

[Tiger_Zhao]

更正，少了步长 6

For i = 0 To UBound(aNum) - 5 Step 6

[Tiger_Zhao]

输出：

6 9 7 9 3 3->9 
1 2 4 2 4 8->2 4 
8 6 7 9 7 9->7 
7 9 3 3 1 2->3 
5 4 1 4 5 6->4 5 
0 7 0 7 0 1->7 0 
2 6 3 5 2 5->2 
6 7 1 8 0 7->7 

[yqlg2000]

热泪盈眶啊

10.11.12楼的正解

不过我把代码粘贴到VB后,生成工程1.EXE.什么应用没反应啊

[yqlg2000]

我现在在网吧
哪位能帮我把代码变成软件吗
VB精简版 没有生exe的功能
企业版的安装要重启,网吧一重启就没了
谢谢了

[yqlg2000]

帮我改一下
不要显示
6 9 7 9 3 3->
1 2 4 2 4 8->
8 6 7 9 7 9->
7 9 3 3 1 2->
5 4 1 4 5 6->
0 7 0 7 0 1->
2 6 3 5 2 5->
6 7 1 8 0 7->

只显示
9
2 4
7
3
4 5
7 0
2
7

代码要什么写