返回列表 上一主題 發帖

[發問] 資料排列問題

本帖最後由 Hsieh 於 2010-10-28 19:56 編輯

回復 5# sandra_wang
妳的範例的middle好像應該只有一筆才對
  1. Sub Ex()
  2. Dim A As Range, d As Object, Col As Integer, s As Long, r As Long, k As Integer, Mystr As String
  3. Dim ky As Variant
  4. Set d = CreateObject("Scripting.Dictionary")
  5. Set A = Range([M1], [M1].End(xlToRight))
  6. A.Resize(10, A.Count) = ""
  7. Col = 13
  8. For k = 8 To 10
  9. If Application.Count(Columns(k)) > 0 Then
  10.    For Each A In Columns(k).SpecialCells(xlCellTypeConstants, 1)
  11.       For i = 1 To A
  12.          s = s + 1
  13.          r = A.Row
  14.          Mystr = Replace(Cells(1, k), "數量", "_") & s
  15.          d(Mystr) = Application.Transpose(Cells(r, 2).Resize(, 4))
  16.       Next
  17.    Next
  18.    
  19.    For Each ky In d.keys
  20.       Cells(1, Col) = ky
  21.       Cells(3, Col).Resize(4, 1) = d(ky)
  22.       Col = Col + 1

  23.    Next
  24. End If
  25. s = 0: d.RemoveAll
  26. Next
  27. End Sub
複製代碼
學海無涯_不恥下問

TOP

本帖最後由 Hsieh 於 2010-10-29 19:37 編輯

回復 8# sandra_wang
  1. Sub Ex()
  2. Dim A As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set Rng = Range("CL2,CX2,DJ2")
  5. [ED2:EL65536] = ""
  6. r = 2
  7. For Each A In Rng
  8.    k = 135
  9.    For i = 7 To 9
  10.    s = 1
  11.       If Application.Count(A.Offset(, i).EntireColumn) > 0 Then
  12.       Cells(r, 134).Resize(5, 1) = Application.Transpose(Array(A, A.Offset(1, 1), A.Offset(1, 2), A.Offset(1, 3), A.Offset(1, 4)))
  13.          For Each b In A.Offset(, i).EntireColumn.SpecialCells(xlCellTypeConstants, 1)
  14.             For j = 1 To b
  15.                Mystr = Cells(3, b.Column) & "_" & s
  16.                s = s + 1
  17.                d(Mystr) = Application.Transpose(Cells(b.Row, A.Column + 1).Resize(, 4))
  18.             Next
  19.          Next
  20.          For Each ky In d.keys
  21.             Cells(r, k) = ky: Cells(r + 1, k).Resize(4, 1) = d(ky)
  22.             k = k + 1
  23.          Next
  24.          d.RemoveAll
  25.       End If
  26.       Next
  27.       r = r + 12
  28. Next
  29. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 願要大、志要堅、氣要柔、心要細。
返回列表 上一主題