標題: 如何在不篩選情況做橫向排序並遞減 [打印本頁]

---

作者: ericpeja    時間: 2019-11-20 00:30     標題: 如何在不篩選情況做橫向排序並遞減

各位好~
由於公司程式測試需要做結果判斷~不過每次測試結果均不相同
因程式筆數較多顧需要做篩選後較好進行判斷
想利用不會影響報表的環境下直接做特殊排列
小弟想把H行依序排列從低到高(並且相同數字不會重複)
之後再將A行中也依序由低到高做排序,最後再將每次Test的結果依序排列橫向到另一工作表
下圖為測試後的報表
[attach]31430[/attach]
欲做橫向排序
[attach]31431[/attach]
附工作表
[attach]31432[/attach]

因測試筆數較多且結果均不固定~可否請版大高手用函數或者vba幫忙協助小弟
感謝~

---

作者: hcm19522    時間: 2019-11-20 10:02

https://blog.xuite.net/hcm19522/twblog/588631977

---

作者: 准提部林    時間: 2019-11-23 13:25

Sub TEST()
Dim xR As Range, xD, U&, N&, T$
Set xD = CreateObject("Scripting.Dictionary")
With Sheets("工作表2")
     .Cells.Clear: .[a1] = "Frequency"
     For Each xR In Range([工作表1!A2], [工作表1!A1].Cells(Rows.Count, 1).End(xlUp))
         If xR.Row = 1 Or Val(xR) = 0 Or Val(xR(1, 8)) = 0 Then GoTo 101
         T = Format(xR, "0000_") & xR & "Vpp"
         U = xD(T)
         If U = 0 Then N = N + 1: U = N: xD(T) = N: .Cells(U + 1, 1) = T
         T = xR(1, 8)
         If xD(T & "/") = 0 Then .Cells(1, Val(T) + 1) = T: xD(T & "/") = 1
         xR(1, 9).Copy .Cells(U + 1, Val(T) + 1)
101: Next
End With
If N = 0 Then Exit Sub
On Error Resume Next
With Sheets("工作表2")
     .Rows(1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
     .UsedRange.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes '由小而大排序
     '.UsedRange.Sort Key1:=.Range("A1"), Order1:=xlDescending, Header:=xlYes '由大而小排序
     .Columns(1).Replace "*_", "", Lookat:=xlPart
     .Select
End With
End Sub


[attach]31448[/attach]


======================================

---

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