- 帖子
- 6
- 主題
- 1
- 精華
- 0
- 積分
- 15
- 點名
- 0
- 作業系統
- Win2000
- 軟體版本
- Excel2010
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2016-3-22
- 最後登錄
- 2022-7-19
|
不好意思 多次麻煩...想再次詢問...我用大大的編碼做整理
最近發現，似乎有跳名次的狀況出現
下圖左邊是大大的編碼所排出的前十大NG設備，右邊是樞紐分析表排出的十大NG設備
最右邊的是設備的排名...- Dim ar, dMachines As Object, dTemp As Object
- ar = [a1].CurrentRegion.Value
- Set dMachines = CreateObject("scripting.dictionary")
- Set dBelong = CreateObject("scripting.dictionary")
- For i = 2 To UBound(ar)
- If Not dMachines.exists(ar(i, 3)) Then
- Set dTemp = CreateObject("scripting.dictionary")
- dMachines.Add ar(i, 3), dTemp
- Else
- Set dTemp = dMachines(ar(i, 3))
- End If
- dTemp(ar(i, 2)) = dTemp(ar(i, 2)) + 1
- dBelong(ar(i, 3)) = ar(i, 1)
- Next
-
- Dim s As String, cnt As Integer
- For Each x In dMachines.keys
- s = "": cnt = 0
- Set dTemp = dMachines(x)
- For Each y In dTemp.keys
- s = s & IIf(Len(s) = 0, "", ",") & y & "*" & dTemp(y)
- cnt = cnt + dTemp(y)
- Next
- dMachines(x) = Array(x, s, "煩請" & dBelong(x) & "協助確認設備情形", cnt)
- Next
-
- 'Output
- With Sheets.Add
- ActiveSheet.Name = "NG設備(表格)"
- cnt = dMachines.Count
- With .[a1]
- .Cells(1, 2).Resize(cnt, 4) = Application.Transpose(Application.Transpose(dMachines.items))
- .Resize(cnt, 5).Sort .Cells(1, 5), xlDescending ', , .Cells(1, 2), xlAscending
- .Cells(1, 5).EntireColumn.ClearContents
- If cnt > 10 Then
- .Offset(10).Resize(cnt - 10, 4).ClearContents
- cnt = 10
- End If
- .Value = Format(Now() - 1, "m月d日")
- .Resize(cnt).Merge
- End With
- End With
請問大大這樣的狀況該如何解QQ?
PS.抱歉實際設備名稱因保密條約得避免公開...造成不便很抱歉... |
|
發表於 2016-3-23 02:33
| 
