- 帖子
- 967
- 主題
- 0
- 精華
- 0
- 積分
- 1001
- 點名
- 0
- 作業系統
- WIN XP
- 軟體版本
- OFFICE 2003
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-11-29
- 最後登錄
- 2022-5-17
 
|
回復 11# tonycho33
Option Explicit
Sub Ex()
Dim R As Integer, R1 As Integer, Rng As Range, Rng1 As Range, a As Range
For Each a In Sheets("主檔").UsedRange
a.Value = Trim(a)
Next
R = 2: R1 = 2
Sheets("紀錄檔").UsedRange.Offset(1).Clear
Sheets("主檔").Activate
Do
Set Rng = Sheets("主檔").Range(Cells(R, "D"), Cells(R, "D").End(xlToRight)).Resize(3)
With Sheets("紀錄檔")
.Cells(R1, "A") = Cells(R, "A")
.Cells(R1, "B") = Cells(R, "B")
R1 = R1 + 1
.Cells(R1, "C").Resize(Rng.Columns.Count, 3) = Application.Transpose(Rng)
.Cells(R1, "G").Resize(Rng.Columns.Count) = Cells(R, "C")
R1 = R1 + Rng.Columns.Count
End With
R = R + 3
Loop While Cells(R, "D") <> ""
End Sub |
|
發表於 2011-12-16 20:50
| 
