新手求助VBA代码

Question

点击刷新，红色区域，按照上面的规则排列下来，请大师给写几行VBA代码，感谢~！

Answer 1

Sub Test()
Dim arr, brr, i&, j&, n&
arr = [a1].Resize([a65536].End(3).Row, 6)
ReDim brr(UBound(arr), 1)
brr(0, 0) = "日期"
brr(0, 1) = "姓名"
For i = 2 To UBound(arr)
For j = 2 To 6
If arr(i, j) > "" Then n = n + 1: brr(n, 0) = arr(i, 1): brr(n, 1) = arr(1, j)
Next j, i
[i1].Resize(n + 1, 2) = brr
MsgBox "OK"
End Sub

Answer 2

Dim arr, brr, i&, j&, n& 这句是什么意思?

Answer 3

上面写的是数组，楼主，基本知识要懂啊。。要不别人写的你看不懂，有啥用，不能变通
写个简单的给你看看把
Sub aa()
    Dim hang As Integer    '变量写了多少行
    Dim a As Integer    '变量
    Dim b As Integer    '变量
    Dim i As Integer    '有多少行需要判断
    Dim j As Integer    '有多少列需要判断
    hang = 2    '默认写起始行为2，就是需要写在哪里的起始行数    i = Range("a65536").End(xlUp).Row    '获取有多少行需要判断
    j = InputBox("输入有多少列")
    '2次循环，解决你的问题
    For a = 2 To i    '起始行为第二行
        For b = 2 To j    '起始列为第二列
            If Trim(Cells(a, b)) <> "" Then '行内不等于空的时候，自动将日期和姓名写到指定位置
                Cells(hang, 9) = Cells(a, 1)    '将日期写在i列
                Cells(hang, 10) = Cells(1, b)    ' 将名字写在J列
                hang = hang + 1    '写入行的自动加1
            End If
        Next
    Next
End Sub
'这样的一个结构你应该，看的懂把？？

Answer 4

很简单的思路：
Private Sub CommandButton1_Click()
    Dim i As Long, k As Long, j As Long
    k = 2 ''初始行号
    For i = 2 To Cells.Rows.Count ''从第2行开始检查
        If Trim(Cells(i, 1)) = "" Then Exit For ''发现第1列内容为空则退出循环
        For j = 2 To 6 ''从第2列到第6列
            If Trim(Cells(i, j)) <> "" Then ''不为空的开始记录
                Cells(k, 9) = "'" & Cells(i, 1) ''添加日期
                Cells(k, 10) = Cells(1, j) ''添加姓名
                k = k + 1 ''行号+1
            End If
        Next
    Next
End Sub