- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2025-1-10
|
28#
發表於 2021-11-25 13:56
| 只看該作者
不會兩個區域都有資料,只會有其中一個
蘿蔔泥 發表於 2021-11-25 13:34 
請再試看看,謝謝
Sub test2()
Dim Arr, Brr(1 To 1000, 1 To 3), Crr()
Dim i&, j&, n%, s%, m%, R%
If [n13] <> "" Then
Arr = [n13].CurrentRegion '來源資料1
For j = 1 To UBound(Arr, 2): For i = 1 To UBound(Arr)
If Arr(i, j) <> "" Then
If n < 7 Then n = n + 1 Else n = 1
s = s + 1: Brr(s, 1) = n
Brr(s, 2) = Arr(i, j): Brr(s, 3) = s
End If
Next i: Next j
ElseIf [k13] <> "" Then
Arr = Range([k13], [k65536].End(3)) '來源資料2
For i = 1 To UBound(Arr)
If Arr(i, 1) <> "" Then
s = s + 1: Brr(s, 2) = Arr(i, 1)
End If
Next
End If
R = Int(s / 7) + 1: ReDim Crr(1 To R, 1 To 7): k = 1
For i = 1 To s
For j = 1 To 7
m = m + 1: If m > s Then GoTo 99
Crr(i, j) = Brr(m, 2)
Next
99: Next i
Range("a13").Resize(R, 7) = Crr '轉貼到3
End Sub
|
|