把原先纵的题目和答案，转成横向的题目和答案，并把错误答案去除

jackly1111

把原先纵的题目和答案，转成横向的题目和答案，并把错误答案去除

   

魚。。

判断颜色，vba写一个处理

jackly1111

魚。。 发表于 2024-6-19 20:32
判断颜色，vba写一个处理

整一个是否可以vba全部实现？

3190496160

Sub 整理()
Dim ar As Variant
Dim br()
Set sh = Sheets("题目答案")
With sh
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "题目答案为空！": End
    ar = .Range("a1:a" & r)
End With
With Sheets("整理")
    .UsedRange = Empty
    zf = 1
    For i = 1 To UBound(ar)
        If ar(i, 1) = "待检查" Then
            zf = zf & "|" & i + 1
        End If
    Next i
    If zf = 1 Then MsgBox "没有待检查标识！": End
    zf = zf & r
    rr = Split(zf, "|")
    For i = 0 To UBound(rr) - 1
        ks = rr(i)
        js = rr(i + 1)
        n = n + 1
        .Cells(n, 1) = ar(ks, 1)
        y = 1
        For s = ks + 1 To js
            If sh.Cells(s, 1).Interior.ColorIndex = 6 Then
                y = y + 1
                .Cells(n, y) = ar(s, 1)
            End If
        Next s
    Next i
End With
MsgBox "ok!"
End Sub

3190496160

题目答案.rar (14.55 KB, 下载次数: 3)

2024-6-20 09:40 上传

点击文件名下载附件

jackly1111

3190496160 发表于 2024-6-20 09:40

谢谢，目前测试一切正常

jackly1111

3190496160 发表于 2024-6-20 09:39
Sub 整理()
Dim ar As Variant
Dim br()

你好，我有个新帖子，是否可以帮忙在看下

题库sheet，在题目后面直接显示答案
https://club.excelhome.net/thread-1702448-1-1.html
(出处: ExcelHome技术论坛)