- 帖子
- 552
- 主題
- 3
- 精華
- 0
- 積分
- 578
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2015-2-8
- 最後登錄
- 2024-7-9
  
|
回復 1# boblovejoyce
試試看吧！- Sub test()
- Dim arr1()
- en = Cells(Rows.Count, 1).End(xlUp).Row
- arr = Range("b2:c" & en)
- x = 1
- j = 1
- For Each Rng In Range("a2:a" & en)
- i = 1
- For Each rng1 In [b1:c1]
- ReDim Preserve arr1(1 To 2, 1 To x)
- arr1(1, x) = Rng & rng1
- arr1(2, x) = arr(j, i)
- x = x + 1: i = i + 1
- Next
- j = j + 1
- Next
- [F1].Resize(UBound(arr1, 2), 2) = Application.Transpose(arr1)
- End Sub
|
|
發表於 2015-6-22 18:34
| 
