純數字數據,3個數字一組,每2組相交,求相交數


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

有一堆純數字數據,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就可以了.



幫忙看下要什么做,謝謝.

23 个解决方案

#1


這個應該沒難度。

“數據源”如何取得?

#2


數據是不固定的

代碼該什么寫啊

#3


搞成數組,loop幾下。

#4


我來拿這個分吧
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

#5


那個.......

我是說數據是不固定的,下次另外一堆數據的時候,還可以用的程序.

#6


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

#7


給你算法思路,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

#8


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

#9


以上假設你的數字都是0-9,如果有大於9的數,GetValue中數組變量lng按最大值聲明...

#10


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

#11


更正,少了步長 6
For i = 0 To UBound(aNum) - 5 Step 6

#12


輸出:
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 

#13


熱淚盈眶啊

10.11.12樓的正解

不過我把代碼粘貼到VB后,生成工程1.EXE.什么應用沒反應啊

#14


我現在在網吧
哪位能幫我把代碼變成軟件嗎
VB精簡版 沒有生exe的功能
企業版的安裝要重啟,網吧一重啟就沒了
謝謝了

#15


幫我改一下
不要顯示
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->

只顯示

2 4 


4 5 
7 0 



代碼要什么寫

#16


有么有msgbox?
8 6 7 9 7 9-> 7,
2 6 3 5 2 5-> 2,
6 7 1 8 0 7-> 7 有問題,筆誤?

#17


引用 13 樓 yqlg2000 的回復:
熱淚盈眶啊

10.11.12樓的正解

不過我把代碼粘貼到VB后,生成工程1.EXE.什么應用沒反應啊


把debug換成form1

#18


引用 14 樓 yqlg2000 的回復:
我現在在網吧
哪位能幫我把代碼變成軟件嗎
VB精簡版 沒有生exe的功能
企業版的安裝要重啟,網吧一重啟就沒了
謝謝了


把你的文件發到郵箱

#19


引用 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

代碼要什么寫


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


#20


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不就可以了

#21


引用 20 樓 king06 的回復:
要不要debug隨你自己啊,代碼不用保存到什么地方,回去了在CSDN這里來copy不就可以了

你把分都給我了,別人的辛勞不是白費了。。。。。。盡管有點得了便宜還賣乖的說

#22


引用 21 樓 king06 的回復:
引用 20 樓 king06 的回復:
要不要debug隨你自己啊,代碼不用保存到什么地方,回去了在CSDN這里來copy不就可以了

你把分都給我了,別人的辛勞不是白費了。。。。。。盡管有點得了便宜還賣乖的說

呵呵,我也來湊個熱鬧。測試了下,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

#23


補充一句,我猜想樓主的數據來源每行可能是分開的,於是就在每行加了個逗號來分割數據。

注意!

本站转载的文章为个人学习借鉴使用,本站对版权不负任何法律责任。如果侵犯了您的隐私权益,请联系我们删除。



 
粤ICP备14056181号  © 2014-2021 ITdaan.com