返回列表 上一主題 發帖

請問如何設定紀錄檔

本帖最後由 GBKEE 於 2011-12-15 17:31 編輯

回復 3# tonycho33
  1. Option Explicit
  2. Sub Ex()
  3.     Dim R As Integer, R1 As Integer, Rng As Range
  4.     R = 2: R1 = 2
  5.     Sheets("紀錄檔").UsedRange.Offset(1).Clear
  6.     Sheets("主檔").Activate
  7.     Do
  8.         Set Rng = Sheets("主檔").Range(Cells(R, "D"), Cells(R, "D").End(xlToRight)).Resize(3)
  9.         With Sheets("紀錄檔")
  10.             .Cells(R1, "A") = Cells(R, "A")
  11.             .Cells(R1, "B") = Cells(R, "B")
  12.            R1 = R1 + 1
  13.             .Cells(R1, "C").Resize(Rng.Columns.Count, 3) = Application.Transpose(Rng)
  14.             .Cells(R1, "G").Resize(Rng.Columns.Count) = Cells(R, "C")
  15.             R1 = R1 + Rng.Columns.Count
  16.         End With
  17.         R = R + 3
  18.     Loop While Cells(R, "D") <> ""
  19. End Sub
複製代碼

TOP

回復 16# register313
另一迴圈 For
  1. Sub Ex2()
  2.     Dim A As Range, i As Integer, R1 As Integer, Rng As Range
  3.     For Each A In Sheets("主檔").UsedRange
  4.       A.Value = Trim(A)
  5.     Next
  6.     Sheets("紀錄檔2").UsedRange.Offset(1).Clear
  7.     With Sheets("主檔")
  8.         For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row Step 3
  9.             Set Rng = .Range(.Cells(i, "D"), .Cells(i, "D").End(xlToRight)).Resize(3)
  10.             With Sheets("紀錄檔2")
  11.                 R1 = .Cells(Rows.Count, "a").End(xlUp).Offset(1).Row
  12.                 .Cells(R1, "A").Resize(Rng.Columns.Count) = Rng.Cells(1, -2)
  13.                 .Cells(R1, "B").Resize(Rng.Columns.Count) = Rng.Cells(1, -1)
  14.                 .Cells(R1, "C").Resize(Rng.Columns.Count, 3) = Application.Transpose(Rng)
  15.                 .Cells(R1, "G").Resize(Rng.Columns.Count) = Rng.Cells(1, 0)
  16.             End With
  17.         Next
  18.     End With
  19. End Sub
複製代碼

TOP

        靜思自在 : 時時好心就是時時好日。
返回列表 上一主題