高分求一最简算法，在8个数中是否有4个一样的数，分不够加

Question

高分求一最简算法，在8个数中是否有4个一样的数，分不够加

Answer 1

我的想法是：
for (i=0;i<8;i++)   从八个数中的第一个开始遍历
   for (j=0;j<8;j++)
      if i=j then continue  如果下标相同，也就是自己，则跳过。
      elseif a[i] = a[j] then [i]++  否则，如果相同就把数组做个标记。
                    数组表示每个书在这八个数中相同的个数。
      end if
for (i=0;i<8;i++)    最后遍历数组，如果大于3，则就说明有四个相同的数。
   if [i]>=3 
      return true 
最后说明一下，上面的代码只是个算法，只是提供个思路，具体再vb里实现应该就不难了吧。

Answer 2

恩，上面fishbob21(fishbob) 做法不错，但是这里
for (i=0;i<8;i++)    最后遍历数组，如果大于3，则就说明有四个相同的数。
   if [i]>=3 
      return true 应该是
   if [i]==4  直接跳出返回。说明找到了。

Answer 3

因为if [i]>=3 没考虑到 5 2 1 的情况。

Answer 4

dim a(7) as long
dim getit as boolean
dim n, i , j as integer
......
for i=0 to 4  '到第 6 个数与 7，8，9 号数字相比，不必循环到底
  n=0
  for j=i+1 to 7  '前面的数字不必再比
    if a(i) = a(j) then n = n + 1
    if n = 4 then getit = true : exit for
  next j
next i
if getit then
  msgbox "you have 4 of " & a(i)
else
  msgbox "4 same numbers not foud"
endif

Answer 5

dim a(7) as long
dim getit as boolean
dim n, i , j as integer
......
for i=0 to 4  '到第 5 个数与 6，7，8 号数字相比，不必循环到底
  n=0
  for j=i+1 to 7  '前面的数字不必再比
    if a(i) = a(j) then n = n + 1
    if n = 4 then getit = true : goto exitsub
  next j
next iexitsub:
if getit then
  msgbox "you have 4 of " & a(i)
else
  msgbox "4 same numbers not foud"
endif

Answer 6

方法1可以改进：
树的节点写一个类：(命名为CNode）
public iVal as integer
public iCount as integer
public leftNode as CNode
public rightNode as CNode用树的方法：
1.第一个数做根，iCount=1
2.读入第二个数，如何第一个相同，则iCount=iCount+1;若不同：
    如果比一个小则放到左边，大则放到右边，并将其iCount设为1。
3.读入第三个数，将它按上法添加到树中

最后一步：遍历一次树，如果有iCount=4的即为所求

Answer 7

楼上的恐怕 都没看清题吧
他是要问有没有4个相同的数啊
不是有没有4对相同数
我是这么想的：
sub a(a(8) as integer)
dim b(8) as integer
for i= 1 to 8
 n=0 
 for j= 1 to 8
  b(j)=a(j)-a(i)
  if b(j)=0 then n=n+1
  if n=4 then goto a
  next
next
msgbox "No result":exit sub
a:
msgbox "U have 4 same num in them"
end sub

Answer 8

同意hnwlf(寻梦),简单，易实现！

Answer 9

关于我所说的方法一：
代码如下:
'Form 中的代码：
Option Explicit
Private Comp As CTreePrivate Sub Form_Click()
    Set Comp = New CTree
    Dim i As Integer
    Dim iTmp As Integer    For i = 0 To 7
        iTmp = Val(InputBox("Plz Input No." & Str(i), "Input"))
        Call Comp.InputVal(iTmp)
    Next i    If Comp.ExistFourEql Then
        Print "Exist"
    Else
        Print "Not Exist"
    End If
    Set Comp = Nothing
End Sub'类CNode中的代码：
Option ExplicitPublic iVal As Integer
Public iCount As IntegerPublic leftNode As CNode
Public rightNode As CNode'类CTree中的代码：
Option ExplicitPrivate mRoot As CNode
Private mbExistFourEql As BooleanPrivate Sub Class_Initialize()
    mbExistFourEql = False
    Set mRoot = New CNode
End SubPrivate Sub Class_Terminate()
    Call DestroyNode(mRoot)
End SubPrivate Sub InsertNode(ByVal Val As Integer, ByRef rNode As CNode)
    If rNode.iCount = 0 Then
        rNode.iVal = Val
        rNode.iCount = 1
    ElseIf rNode.iVal = Val Then
        rNode.iCount = rNode.iCount + 1
        If rNode.iCount = 4 Then mbExistFourEql = True
    ElseIf Val < rNode.iVal Then
        If rNode.leftNode Is Nothing Then Set rNode.leftNode = New CNode
        Call InsertNode(Val, rNode.leftNode)
    Else
        If rNode.rightNode Is Nothing Then Set rNode.rightNode = New CNode
        Call InsertNode(Val, rNode.rightNode)
    End If
End SubPrivate Sub DestroyNode(ByRef rNode As CNode)
    If Not (rNode.leftNode Is Nothing) Then Call DestroyNode(rNode.leftNode)
    If Not (rNode.rightNode Is Nothing) Then Call DestroyNode(rNode.rightNode)
    Set rNode = Nothing
End SubPublic Property Get ExistFourEql() As Boolean
    ExistFourEql = mbExistFourEql
End PropertyPublic Sub InputVal(ByVal Val As Integer)
    Call InsertNode(Val, mRoot)
End Sub
'注：VB中的传地址（引用）功能很有限，所以完全按照C的做法可能不行（也许是我功力不够吧）。以上代码可能写的罗嗦了些，仅供参考。

Answer 10

楼上说的是，如果想简单，只要这样就可以了：
'Form中的代码：
Option ExplicitPrivate Comp As CCompPrivate Sub Form_Click()
    Dim i As Integer
    Set Comp = New CComp
    For i = 0 To 7
        Comp.Reciever = val(InputBox("Plz Input NO." & Str(i), "Input"))
    Next i
    If Comp.ExistFourEql Then
        Print "Exist"
    Else
        Print "Not Exist"
    End If
    Set Comp = Nothing
End Sub'类CComp中的代码：
Option ExplicitPrivate Type NumCounter
    val As Integer
    count As Integer
End TypePrivate Const MAX_ELEM As Integer = 8
Private mbExist As BooleanPrivate mArray(MAX_ELEM - 1) As NumCounterPublic Property Let Reciever(val As Integer)
    Dim i As Integer
    For i = 0 To MAX_ELEM - 1
        With mArray(i)
            If .count = 0 Then
                .val = val
                .count = 1
                Exit Property
            ElseIf .val = val Then
                .count = .count + 1
                If .count = 4 Then mbExist = True
                Exit Property
            End If
            
        End With
    Next i
End PropertyPublic Property Get ExistFourEql() As Boolean
    ExistFourEql = mbExist
End PropertyPrivate Sub Class_Initialize()
    mbExist = False
End Sub

Answer 11

我的方法是先统计出现频度，然后查找频度超过4的。也许通用性强一些，针对性稍微差一点。Function Test(v() As Integer) As Boolean
Dim x(8, 2) As Integer
Dim i As Integer, j As Integer
Dim c As Integerc = 0
For i = 1 To 8
    For j = 1 To c
        p = p + 1
        If x(j, 1) = v(i) Then
            x(j, 2) = x(j, 2) + 1
            Exit For
        End If
    Next j
    If j = c + 1 Or c = 0 Then
        c = c + 1
        x(c, 1) = v(i)
        x(c, 2) = 1
    End If
Next iTest = False
For i = 1 To 8
    If x(i, 2) >= 4 Then Test = True
Next i
End Function

Answer 12

'此问题的另类算法Private Sub Command1_Click()Dim b(7) As Integer
b(0) = 45
b(1) = 45
b(2) = 4
b(3) = 45
b(4) = 5
b(5) = 45
b(6) = 1
b(7) = 9
   '先排序
For c = 0 To 6
 For a = 0 To 6 - c
  If b(a) > b(a + 1) Then
    temp1 = b(a)
    b(a) = b(a + 1)
    b(a + 1) = temp1
  End If
 Next a
Next c
   '再判断
For e = 0 To 4
 If b(e) = b(e + 1) And b(e + 1) = b(e + 2) And b(e + 2) = b(e + 3) Then
 MsgBox "有"
 Exit For
 End If
Next eEnd Sub

Answer 13

sorry, 我的程序中 p = p + 1 是调试信息，没有用。

Answer 14

要最简单的方法很容易，开一个集合，不同的就加上去，不同的就把个数加一，不就行了？
dim a(7) as long '存放变量
dim dCount(7) as long'存放个数
dim i as long'循环因子
dim j as long'另一个循环因子
dim b as new Collection...'给a()赋值    b.Add a(0)
    dCount(0) = 1
    For i = 1 To 7
        For j = 0 To b.Count - 1
            If a(i) = b(j) Then
                dCount(j) = dCount(j) + 1
                GoTo 1
            End If
            b.Add a(i)
            dCount(b.Count - 1) = 1
1:
        Next
    Next
    
    For j = 0 To b.Count - 1
        Debug.Print dCount(j)
    Next