­ã´£³¡ªL

Sub TEST()
Dim xR As Range, xD, U&, N&, T$
Set xD = CreateObject("Scripting.Dictionary")
With Sheets("¤u§@ªí2")
     .Cells.Clear: .[a1] = "Frequency"
     For Each xR In Range([¤u§@ªí1!A2], [¤u§@ªí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("¤u§@ªí2")
     .Rows(1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
     .UsedRange.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes '¥Ñ¤p¦Ó¤j±Æ§Ç
     '.UsedRange.Sort Key1:=.Range("A1"), Order1:=xlDescending, Header:=xlYes '¥Ñ¤j¦Ó¤p±Æ§Ç
     .Columns(1).Replace "*_", "", Lookat:=xlPart
     .Select
End With
End Sub


Xl0000146.rar (16.26 KB)

¤U¸ü¦¸¼Æ: 9

2019-11-23 13:25

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