Question

当数组个数小于3个时，输出数组内所有值？

A列为班级，B列为姓名，C列为成绩；
如果C>90，则存入数组arr中；
1、arr只有3个值或更少时，输出文字“姓名1成绩为XX,姓名2成绩为XX,姓名3成绩为XX"
（XX为对应学生的成绩）
2、如果arr有3个值以上，则输出文字：X个学生的成绩在XX-XX之间；(X为arr数组内数字个数，XX为成绩)
求VBA代码

Answer 1

第一种情况：

第二种情况：

代码文本：

Function 数组(a As Range)

Dim arr(1 To 100), brr(1 To 100)

For i = 2 To a.Cells(65536, 1).End(3).Row

    If a.Cells(i, 2) > 90 Then

        n = n + 1

        arr(n) = a.Cells(i, 1)

        brr(n) = a.Cells(i, 2)

    End If

Next

If n < 4 Then

    For j = 1 To n

        数组 = 数组 & "," & arr(j) & "成绩为" & brr(j)

    Next

    数组 = Mid(数组, 2)

Else

    数组 = n & "个学生的成绩在" & Application.Min(brr) & "到" & Application.Max(brr) & "之间"

End If

End Function

追问

如果有其他科目成绩新增，如成绩分成了语文，数学，等科目；
需要改动哪些呢，能不能麻烦举个例子？

追答

这个具体得看你的排版方式，在哪个位置，是否固定，需不需要代码判断。

追问

继续往D-E-F~~~后排即可，也是固定的，判断的话，和之前一样也是大于一个固定值；
代码我是看懂了，但是好像要新增多几列比较麻烦，例如有两门科目的话，相当于我要加多crr,drr，以及再原来基础上再加两个循环？
有没有再便一点的方法呢，用一两个循环就可以搞定新增多列成绩的问题

追答

到不用加那么多其他数组，一个ARR定义成多维数组就可以了，你这个继续往后D-E-F~~~是最后到F吗？还是后面还有，最好有一个固定的范围，代码才好改

追问

A列为班级，B列为姓名，C列为成绩1，D列成绩2，E列成绩3，F列成绩4；
到F也就够了，门限和描述还是照旧，倒时候我自己再改改就好

追答

我才发现我写的自定义公式，不是SUB，你看改成这样能实现你的要求不

Answer 2

VBA我不玩的，但是你描述的情况应该可以用数组公式实现的：

=IF(COUNTIF(C:C,">90")<4,TEXTJOIN(",",TRUE,IF(C:C>90,A:A&B:B&C:C,"")),COUNTIF(C:C,">90")&"个学生的成绩在90以上")

或者是：

=IF(COUNTIFS(C:C,">90",C:C,"<=100")<4,TEXTJOIN(",",TRUE,IF((C:C>90)*(C:C<=100),A:A&B:B&C:C,"")),COUNTIFS(C:C,">90",C:C,"<=100")&"个学生的成绩在90-100之间")

是数组公式！！！必须CTRL+SHIFT+ENTER这3个键同按结束，否则公式会无效哦！！

Answer 3

Sub cj()
Dim arr(), i&, r&, n As Byte, j As Byte, X%, Xmin As Byte, Xmax As Byte, a$
r = Cells(Rows.Count, 1).End(3).Row
Xmin = 90 '设置成绩下限
Xmax = 120 '设置满成绩
X = Application.CountIf(Range("c2:c" & r), ">" & Xmin)
If X > 3 Then
a = X & "个学生成绩在" & Xmin & "-" & Xmax & "之间"
ElseIf X = 0 Then
a = "没有学生的成绩大于" & Xmin
Else
ReDim arr(1 To X, 1 To 2)
For i = 2 To r
If Cells(i, 3) > Xmin Then
n = n + 1
arr(n, 1) = Cells(i, 2)
arr(n, 2) = Cells(i, 3)
End If
Next
For j = 1 To n
For i = 1 To n
If arr(i, 2) = Application.Max(arr) Then
a = a & arr(i, 1) & "成绩为" & arr(i, 2) & " "
arr(i, 2) = ""
End If
Next
Next
End If
a = Application.Substitute(Application.Trim(a), " ", "，")
MsgBox a
[e2] = a
End Sub