用VBA把不及格者姓名科目成绩提取出来

laoau138

用VBA把不及格者姓名科目成绩提取出来

lisachen

laoau138

lisachen 发表于 2016-9-27 13:20

有没有第三种方法

laoau138

lisachen 发表于 2016-9-27 13:20

第一种

Sub test()
    Dim arr, brr(1 To 1000, 1 To 3)
    Dim k%
    arr = Range("a1").CurrentRegion
    For x = 2 To UBound(arr)
        For y = 2 To 8
            If Cells(x, y) < 60 Then
                k = k + 1
                brr(k, 1) = arr(x, 1)
                brr(k, 2) = arr(1, y)
                brr(k, 3) = arr(x, y)
            End If
        Next y
    Next x
    Range("m2").Resize(k, 3) = brr

End Sub



第二种


Sub tiqu()
Dim arr, i%, j%, k%, brr()
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
    For j = 2 To UBound(arr, 2)
        If arr(i, j) < 60 Then
            k = k + 1
            ReDim Preserve brr(1 To 3, 1 To k)
            brr(1, k) = arr(i, 1)
            brr(2, k) = arr(1, j)
            brr(3, k) = arr(i, j)
        End If
    Next j
Next i
Intersect(ActiveSheet.UsedRange, Range("J:L")).ClearContents
[J1:L1] = [{"姓名","科目","成绩"}]
[j2].Resize(k, 3) = WorksheetFunction.Transpose(brr)
End Sub

pengyx

If Cells(x, y) < 60 Then 就是这句
                k = k + 1
                brr(k, 1) = arr(x, 1)
                brr(k, 2) = arr(1, y)
                brr(k, 3) = arr(x, y)
            End If
这里没有看懂？？？

today0427

pengyx 发表于 2016-9-27 13:30
If Cells(x, y) < 60 Then 就是这句
                k = k + 1
                brr(k, 1) = arr(x, 1) ...

pengyx

第三种方法：设一个0到59的数组，把成绩依次写时去，能写进的就是不及格的，不能写入的就是及格的

laoau138

pengyx 发表于 2016-9-27 13:59
第三种方法：设一个0到59的数组，把成绩依次写时去，能写进的就是不及格的，不能写入的就是及格的

把代码写出来，我的智商不够，无法理解你

today0427

我也照这个思路试试看

苏子龙

laoau138 发表于 2016-9-27 13:30
第一种

Sub test()

第一和第二不是一样的吗