- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2015-7-12 15:41
| 只看該作者
回復 1# lionliu
試試看- Option Explicit
- Sub Ex()
- Dim Rng As Range, i As Integer, Msg As Boolean
- Set Rng = Sheets(1).[A2]
- With Sheets(2)
- .UsedRange.Clear '.UsedRange的範圍 < .Cells的範圍,處裡速度會快些
- .Range("a1").Resize(, 4) = Array("Description", "Qty", "Price", "Amount") '一起給值
- i = 2 '設定起始值
- Do While Rng <> "" 'Rng ="" 迴圈停止
- If Msg = False Then
- .Cells(i, "A") = Rng.End(xlUp) & ": " & Rng
- i = i + 1
- End If
- .Cells(i, "A") = Rng.Cells(1, 2).End(xlUp) & ": " & Rng.Cells(1, 2) 'item no
- .Cells(i, "B").Resize(, 3) = Rng.Cells(1, 4).Resize(, 3).Value 'qty,price, amount
- .Cells(i + 1, "A") = Rng.Cells(1, 3) 'Description
- i = i + 2
- Msg = False '設 po no 不相同
- If Rng = Rng.Offset(1) Then Msg = True 'po no 相同
- Set Rng = Rng.Offset(1) '下移一列
- Loop
- End With
- End Sub
複製代碼 |
|