點擊重繪，紅色區域，按照上面的規則排列下來，請大師給寫幾行VBA代碼，感謝~！
uj5u.com熱心網友回復：
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
uj5u.com熱心網友回復：
Dim arr, brr, i&, j&, n& 這句是什么意思?uj5u.com熱心網友回復：
上面寫的是陣列，樓主，基本知識要懂啊。。要不別人寫的你看不懂，有啥用，不能變通
寫個簡單的給你看看把
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
'這樣的一個結構你應該，看的懂把？？
uj5u.com熱心網友回復：
很簡單的思路：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
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/113887.html
標籤：VBA