vb循环和条件判断

Question

现在有一个数组（5个元素），如果这五个数值有相差小于1的，合并为一组并求平均数，如果相差没有小于1的，保留原数，求最后有几组，并求出各组平均数.如果不清楚就看例子！

例1：一个数组数值分别为 1,3,4,7,8
3和4相差1,7和8相差1，合并为一组，所以一共有3组
第一组数值为1，第二组数值为(3+4)/2,第三组数值为(7+8)/2
输出：组数|1 2 3
数值|1 3.5 7.5
例2：一个数组1,3,4,5,6
分为2组，第一组1，第二组（3+4+5+6）/4
输出：组数|1 2
数值|1 4.5
高分求解！！！！
在线等啊！！！急用！！！

Answer 1

Private Sub Command1_Click()
Dim k()
Dim k2()

Label1.Caption = "": Label2.Caption = ""
k = Array(4, 7, 5, 6, 9)
'排序
BubbleSort2 k

For i = 0 To UBound(k)
'Debug.Print k(i) '测试排序结果
Next
'分组
ReDim k2(0)
k2(0) = 0
For i = 0 To UBound(k) - 1
If k(i + 1) - k(i) > 1 Then
ReDim Preserve k2(UBound(k2) + 1)
k2(UBound(k2)) = i + 1
End If
Next
ReDim Preserve k2(UBound(k2) + 1)
k2(UBound(k2)) = UBound(k) + 1

'求每组结果
For i = 0 To UBound(k2) - 1
tmp = 0: tmp1 = 0
For n = k2(i) To k2(i + 1) - 1
tmp = tmp + k(n)
tmp1 = tmp1 + 1
Next
tmp = tmp / tmp1
Label1.Caption = Label1.Caption & (i + 1) & " "
Label2.Caption = Label2.Caption & tmp & " "
Next
End Sub
'冒泡排序法
Private Function BubbleSort2(ArrayToSort()) As Boolean
Dim SortLoop As Long
Dim HoldValue
Dim ChangeMade As Boolean
Dim endLoop As Long

ChangeMade = True
Do While ChangeMade
ChangeMade = False
For SortLoop = LBound(ArrayToSort) To UBound(ArrayToSort) - 1
If ArrayToSort(SortLoop) > ArrayToSort(SortLoop + 1) Then
HoldValue = ArrayToSort(SortLoop)
ArrayToSort(SortLoop) = ArrayToSort(SortLoop + 1)
ArrayToSort(SortLoop + 1) = HoldValue
ChangeMade = True
End If
Next SortLoop
Loop
BubbleSort1 = True

End Function

追问

谢谢，运行完美！！！！！只是组数和数据不对称，我自己改吧，太谢谢了！！！！另外也十分感谢橡皮树的博客，非常感激！！！感激涕零，回去研究研究！！！你们的代码对我来说都很有价值！

本来追问橡皮树的，可惜追问一直审核。。。。（带图），2位高手，感激感激X+oo

Answer 2

Private Sub Command1_Click()
Dim k() As Variant, s As Integer
Dim k2() As Single, t As Single
Dim i As Integer, c As Integer
Dim J As Integer

k = Array(1, 3, 4, 5, 7, 8)
‘如果必要，可以先进行排序
s = k(0): c = 1: t = s
For i = 1 To UBound(k)
If k(i) - s <= 1 Then
t = t + s + k(i)
c = c + 1
Else
ReDim Preserve k2(J)
k2(J) = t / c
t = 0: c = 1: J = J + 1
End If
s = k(i)
Next i
ReDim Preserve k2(J)
k2(J) = t / c

'输出
For i = 0 To UBound(k2)
Debug.Print k2(i)
Next i
End Sub

追问

高手你好，我根据我的程序改动了一点发现不对，自己找不出错误，能不能帮忙看下，解决了追加50分！
1.用例题所示输出组数和每组数据，在label1.caption中输出组数，label2中输出各组值
例：
label1.caption 1 2 3
label2.caption 1 3.5 7.5

追答

就是最后用label控件显示结果？

追问

比如：我添加了2个label：label1显示组数（有几组就显示几组，如：有3组就是1 2 3（有空格）5组就是1 2 3 4 5）
label2显示每组平均值（就是你的k2(i)）当然，与上面组数对其，如题所示；
比如；
1 2 3
1 3.5 7.5

追答

Private Sub Command1_Click()
Dim k() As Variant, s As Integer
Dim k2() As Single, t As Single
Dim i As Integer, c As Integer
Dim J As Integer

k = Array(1, 3, 4, 7, 8)

s = k(0): c = 1: t = s
For i = 1 To UBound(k)
If k(i) - s <= 1 Then
t = t + s + k(i)
c = c + 1
Else
ReDim Preserve k2(J)
k2(J) = t / c
t = 0
c = 1
J = J + 1
End If
s = k(i)
Next i
ReDim Preserve k2(J)
k2(J) = t / c

Dim mm As String
Dim nn As String
'输出

mm = 1: nn = k2(0)
For i = 1 To UBound(k2)
mm = mm & Space(10 - i) & i + 1
nn = nn & Space(10 - Len(CStr(k2(i - 1)))) & k2(i)
Next i
Label1 = mm
Label2 = nn
End Sub

Answer 3

先设变量取你给定的值，用个循环的方法，先判断有几组数，然后将判断结果写入一组变量数组中（由组数确定数组大小），完成判断，再根据要求输出这个数组。

Answer 4

让像屁鼠给你做个代码

追问

你帮我联系啊

追答

好的，先采纳再重新问。

Answer 5

将数据加入列表框内
如数组1：（1,3,4,7,8）
For i = 0 To List1.ListCount - 2
For j = i + 1 To List1.ListCount - 1
If Val(List1.List(j), 1) - Val(List1.List(i), 1) = 1 Then
List2.AddItem i
List2.AddItem j '将两个数送到列表框二
End If
Next j
Next i

追问

先谢谢了，能不能不用列表框，而且条件不是等于1，而是小于等于1

追答

'符号改成<就行了
'可以用文本框
'文本框用数组一样的
文本框一为数组（文本框用复制方法）
For i = 0 To 9 ‘文本框如有十个就写9
If Text1(i + 1).Text - Text1(i).Text < 1 Then
Text2.Text = Text1(i).Text ’输出第一个数字到文本二
Text3.Text = Text1(i).Text ’输出第一个数字到文本三
End If
Next i
'然后
Text4.Text = (Text2.Text+Text3.Text)/2 '将平均数输出到文本框四

追问

先谢谢了，但是如果有3个数都小于等于1那就要3个数相加除以3了，你这个好像只能求2个的。。没判断。。。

追答

也可以这样
For a = 0 To 9 '假如有11个号的话
Forb= a+1
For c = b+1 ‘那么c 就是11了
If Text1(b).Text - Text1(a).Text < 1 Then
"将两数传送"
ElseIf Text1(c).Text - Text1(b).Text < 1 Then
"将两数传送"
End If
Next c
Next b
Next a
看懂了吧

追问

你好！你的程序存在各种问题，很抱歉。。。