返回列表 上一主題 發帖

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

ericpeja

帖子
9 
主題
3 
精華
0 
積分
10 
點名
0  
作業系統
WIN 8 
軟體版本
OFFICE2003 
閱讀權限
10 
註冊時間
2019-7-20 
最後登錄
2020-9-6 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2019-11-20 00:30 | 只看該作者

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

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

欲做橫向排序

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

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

hcm19522

帖子
1368 
主題
4 
精華
0 
積分
1378 
點名
0  
作業系統
WIN 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2015-9-11 
最後登錄
2024-7-3 

熱烈參與勳章
2#
發表於 2019-11-20 10:02 | 只看該作者
https://blog.xuite.net/hcm19522/twblog/588631977
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

准提部林

帖子
2820 
主題
10 
精華
0 
積分
2876 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-7-3 
3#
發表於 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


Xl0000146.rar (16.26 KB)


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

TOP

        靜思自在 : 信心、毅力、勇氣三者具備，則天下沒有做不成的事。
返回列表 上一主題