如何在不篩選情況做橫向排序並遞減

ericpeja

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

下載 (148.57 KB)

2019-11-20 00:25

欲做橫向排序

下載 (124.65 KB)

2019-11-20 00:26

附工作表
測試.rar (23.85 KB)

下載次數: 10

2019-11-20 00:27

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

hcm19522

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

准提部林

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


Xl0000146.rar (16.26 KB)

下載次數: 9

2019-11-23 13:25

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