標題: [發問] 關於資料轉置請教 [打印本頁]

---

作者: alexpig70    時間: 2018-8-23 12:53     標題: 關於資料轉置請教

各位好
請問是否能用公式讓附件中量測日期資料轉置，以用於資料庫整理。
嘗試用過offset，還是試不出來。



感謝高手指點。

---

作者: rouber590324    時間: 2018-8-28 11:03

SIR
如下  

Sub test()
    Dim arr
    arr = Sheet1.Range("E2:J50")
    Sheet1.Range("S2").Resize(UBound(arr, 2), UBound(arr)) = Application.WorksheetFunction.Transpose(arr)
End Sub

---

作者: rouber590324    時間: 2018-8-28 11:24

SIR
涵數如下 .然後往右COPY程式   
S2=OFFSET($E$2,COLUMN()-19,,,)
S3=OFFSET($F$2,COLUMN()-19,,,)
S4=OFFSET($G$2,COLUMN()-19,,,)
S5=OFFSET($H$2,COLUMN()-19,,,)
S6=OFFSET($I$2,COLUMN()-19,,,)
S7=OFFSET($J$2,COLUMN()-19,,,)

---

作者: 准提部林    時間: 2018-8-28 14:28

Sub TEST()
Dim xR As Range, j%, xH As Range
[S2:BO2].Resize(10000).ClearContents
[S:S].NumberFormatLocal = "yyyy/mm/dd"
[T:BO].NumberFormatLocal = "G/通用格式"
For Each xR In Range("E2:E" & [A65536].End(xlUp).Row)
    If xR(1, 0) <> "量測日期" Then GoTo 101
    For j = 1 To 9
        If IsDate(xR(1, j)) And xR(1, j) > 0 Then
           Set xH = Range("S" & xR.Row + j - 1).Resize(1, 49)
           xH = Application.Transpose(xR(1, j).Resize(49))
        End If
    Next j
101: Next
End Sub

---

作者: n7822123    時間: 2018-8-29 01:55

本帖最後由 n7822123 於 2018-8-29 02:07 編輯

1. Sub test1()
   
2. Dim n As Long, rg1 As Range, rg2 As Range
   
3. [s2].Resize(65536, 49) = ""
   
4. Do While Cells(2 + 49 * n, 5) <> ""
   
5.   Set rg1 = Cells(2 + 49 * n, 5).Resize(49, 6)
   
6.   Set rg2 = Cells(2 + 49 * n, 19).Resize(6, 49)
   
7.   rg2 = Application.Transpose(rg1): n = n + 1
   
8. Loop
   
9. End Sub

複製代碼

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)