- 帖子
- 2848
- 主題
- 10
- 精華
- 0
- 積分
- 2903
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2026-7-25
|
Sub 資料轉置貼上()
Dim Arr, Brr, i&, j&, T$, R&, C%
Range("a13:g2000").ClearContents
If [k13] <> "" Then Arr = Range([k13], [k65536].End(xlUp)(2))
If [n13] <> "" Then Arr = [n13].CurrentRegion
ReDim Brr(1 To 2000, 1 To 7)
If Not IsArray(Arr) Then Brr(1, 1) = Arr: GoTo 999 '若資料只有一個~~ For j = 1 To UBound(Arr, 2)
For i = 1 To UBound(Arr)
T = Arr(i, j): If T = "" Then GoTo i01
C = C + 1: Brr(R + 1, C) = T
If C = 7 Then C = 0: R = R + 1
i01: Next i
Next j
999: [a13].Resize(R + 1, 7) = Brr
End Sub |
|