返回列表下一主題上一主題發帖

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

ericpeja

小學生 Rank: 1

帖子: 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幫忙協助小弟
感謝~

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-22

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

hcm19522