返回列表 上一主題 發帖

[發問] 矩陣資料轉置的疑問

回復 1# fusayloveme
  1. Sub test()
  2.     Dim arSrc(), arDes()
  3.    
  4.     arSrc = Sheets(1).[A1].CurrentRegion.Value
  5.     ReDim arDes(1 To 1 + (UBound(arSrc, 2) - 3) * (UBound(arSrc) - 1), 1 To 5)
  6.     '欄位名稱
  7.     arDes(1, 1) = "日期": arDes(1, 2) = "測項"
  8.     arDes(1, 3) = "測站": arDes(1, 4) = "時間"
  9.     arDes(1, 5) = "測值"
  10.         
  11.     Dim i As Long, j As Long, r As Long
  12.     r = 2
  13.     For i = 2 To UBound(arSrc)
  14.         For j = 4 To UBound(arSrc, 2)
  15.             arDes(r, 1) = arSrc(i, 1)
  16.             arDes(r, 2) = arSrc(i, 3)
  17.             arDes(r, 3) = arSrc(i, 2)
  18.             arDes(r, 4) = arSrc(1, j)
  19.             arDes(r, 5) = arSrc(i, j)
  20.             r = r + 1
  21.         Next
  22.     Next
  23.    
  24.     With Sheets.Add
  25.         With .[A1].Resize(UBound(arDes), UBound(arDes, 2))
  26.             .Value = arDes
  27.             .Borders.LineStyle = xlContinuous
  28.             .Borders.Weight = xlThin
  29.         End With
  30.     End With
  31.    
  32. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

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