- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
5#
發表於 2011-3-2 20:02
| 只看該作者
回復 4# lone_tiger0303 - Option Explicit
- Sub Ex()
- Dim I As Integer, C, AR()
- ReDim AR(1, 0)
- With Sheet1
- For I = 1 To .[A3].End(xlToRight).Column
- For Each C In .Range(.Cells(4, I), .Cells(Rows.Count, I).End(xlUp))
- If C <> "" And C.Row > 3 Then
- AR(0, UBound(AR, 2)) = C
- AR(1, UBound(AR, 2)) = .Cells(3, I)
- ReDim Preserve AR(1, UBound(AR, 2) + 1)
- End If
- Next
- Next
- End With
- With Sheet2
- .Range(.[A3], .[B3].End(xlDown)) = ""
- .[A3].Resize(UBound(AR, 2), 2) = Application.WorksheetFunction.Transpose(AR)
- End With
- End Sub
複製代碼 |
|