返回列表 上一主題 發帖

[發問] 如何轉置並重組資料排列方式

回復 1# luke
  1. Sub ex()
  2. Dim Rng As Range, r&, ar(), i%, j%, k%, n%, m$
  3. Set Rng = Range("A:C").SpecialCells(xlCellTypeConstants)
  4. r = 2
  5. For i = 1 To Rng.Areas.Count
  6.    ar = Rng.Areas(i).Value
  7.    For j = 1 To UBound(ar, 1)
  8.       k = 1
  9.       Do Until Asc(Mid(ar(j, 3), k)) >= 1 And Asc(Mid(ar(j, 3), k)) <= 256
  10.         k = k + 1
  11.       Loop
  12.       m = Mid(ar(j, 3), k)
  13.       n = Application.Match(ar(j, 1), Array("巴士", "站牌起點", "站牌中繼A", "站牌中繼B", "站牌終點"), 0)
  14.       Cells(r, n + 4).Resize(3, 1) = Application.Transpose(Array(ar(j, 1), m, ar(j, 2)))
  15.    Next
  16. r = r + 3
  17. Next
  18. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 3# luke
  1. Sub ex()
  2. Dim Rng As Range, r&, ar(), i%, j%, k%, n%, m$
  3. Set Rng = Range("A:C").SpecialCells(xlCellTypeConstants)
  4. r = 2
  5. For i = 1 To Rng.Areas.Count
  6.    ar = Rng.Areas(i).Value
  7.    For j = 1 To UBound(ar, 1)
  8.       k = 1
  9.       Do Until (Asc(Mid(ar(j, 3), k)) < 0 Or Asc(Mid(ar(j, 3), k)) > 256) And Asc(Mid(ar(j, 3), k + 1)) >= 0 And Asc(Mid(ar(j, 3), k + 1)) <= 256
  10.         k = k + 1
  11.       Loop
  12.       m = Mid(ar(j, 3), k + 1)
  13.       n = Application.Match(ar(j, 1), Array("巴士", "站牌起點", "站牌中繼A", "站牌中繼B", "站牌終點"), 0)
  14.       Cells(r, n + 4).Resize(3, 1) = Application.Transpose(Array(ar(j, 1), m, ar(j, 2)))
  15.    Next
  16. r = r + 3
  17. Next
  18. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 【行善要及時】行善要及時,功德要持續。如燒開水一般,未燒開之前千萬不要停熄火候,否則重來就太費事了。
返回列表 上一主題