1234567
返回列表 上一主題 發帖

[發問] vba的篩選功能 (取消部分篩選)

wei9133

帖子
58 
主題
9 
精華
0 
積分
117 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
註冊時間
2017-12-2 
最後登錄
2021-12-16 
55# 跳轉到 »
發表於 2020-11-2 02:53 | 只看該作者
回復 50# 軒云熊


    你好#50的巨集，無法正常執行

TOP

wei9133

帖子
58 
主題
9 
精華
0 
積分
117 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
註冊時間
2017-12-2 
最後登錄
2021-12-16 
54#
發表於 2020-11-1 00:10 | 只看該作者
回復  wei9133

請問 勝率 理論上應該是   勝率 = 勝場/(勝場+敗局)*100%   是否是這樣?
如果 +1  -1  ...
軒云熊 發表於 2020-10-31 12:12


因為我打的名稱不嚴謹造成誤會orz
我把格子名稱改掉了，CY是勝場DA是敗場
如准提部林提到，那個格子應該是勝場數，後面應該是敗場數
新列本身就代表一次勝利，有相同條件的勝利就合併，然後把勝場數加上去
敗場則是直接加上去
左方為輸掉的組合，右方為可以打贏左方配置的組合

至於敗場怎麼來的
用篩選找出對方出戰的角色，然後看右邊可以贏的組合，拿去打
結果輸了，敗場就自己加1上去

因為對戰是有機率性的，就算是可以贏的組合也可能會輸，所以才有填上敗場的格子
可能第一次統計的時候僥倖打過了，然後用同樣組合再去打，結果一直輸
敗局就會一直加上去，若敗場遠大於勝場，就代表統計錯誤
我會在自己把它顛倒過來
(把左右的配置顛倒，敗勝場的數字也換過來)
例如

AB VS CD  贏5 輸10
自己把它改成
CD VS AV 贏10 輸5

至於你上面給的vba我晚一點找時間測試
感謝

TOP

wei9133

帖子
58 
主題
9 
精華
0 
積分
117 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
註冊時間
2017-12-2 
最後登錄
2021-12-16 
53#
發表於 2020-10-31 23:59 | 只看該作者
回復 49# 准提部林


   
基本概念:
資料表應是"流水表"與"統計表"分開,
1) 流水表: 為所有對戰記錄, 可重覆, 也可累積, 也可將已被統計過的刪除, 減少比對工作及時間,
    勝場為空的, 表示是新記錄, 統計過了填入1, 以免再執行統計時又計一次
2) 統計表: 只留各組合的唯一, 舊組合直接累計, 新組合則新增一筆, 保證不重覆,
    必須有對戰總次數, 及勝場數, 才能換算勝率, 統計完後, 以總對戰數為主,勝率為次排序,
   __過去已有的對戰記錄統計, 須事先手動建立


我目前是這都只做到你寫的第一段，手動執行第二段
(查詢到的時候發現一樣的就把一樣的合併，勝場欄位加總，重複的刪掉)

我也不知對不對? __計算邏輯也還搞不清楚
依表來看, 左方為勝方, 右方為敗方, 但如何知道"我方"是左還是右???
所以, 這表只能統計"勝場數", 而非"勝率"


左邊是敗方，右邊是勝方，不分敵我
查詢的時候將對方出戰角色(需敗方)篩選起來，就可以看右半部的勝方，有哪幾種組合可勝，總共勝了幾場，敗了幾場
然後用右(勝)方的組合去打左(敗)方的組合

的確，CY那欄確切名稱應該叫勝場數，而非勝率。

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
52#
發表於 2020-10-31 12:12 | 只看該作者
本帖最後由 軒云熊 於 2020-10-31 12:18 編輯

回復 41# wei9133

請問 勝率 理論上應該是   勝率 = 勝場/(勝場+敗局)*100%   是否是這樣?
如果 +1  -1  好像怪怪的
Cells(x, 116) = Format(Cells(x, 103) / (Cells(x, 103) + Cells(x, 105)), "###%")

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-26 
51#
發表於 2020-10-31 09:19 | 只看該作者
回復 50# 軒云熊


我也不知對不對? __計算邏輯也還搞不清楚
依表來看, 左方為勝方, 右方為敗方, 但如何知道"我方"是左還是右???
所以, 這表只能統計"勝場數", 而非"勝率"

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
50#
發表於 2020-10-30 20:30 | 只看該作者
回復 49# 准提部林


感謝 準大指導 不知道這樣改 是不是有接近 準大說的方法
看起來還是有差很多 結果與 jcchiang前輩的不同  不知如何修改...
  1. Public Sub 練習1030_02()
  2. Sheets(2).Select
  3. Rows(2).Select
  4. ActiveWindow.FreezePanes = False
  5. Application.ScreenUpdating = False
  6. Sheets(2).[a1].CurrentRegion.Clear
  7. Sheets(1).Select
  8. Dim Arr, D, xD, x&, y&, k&, T1$, T2$, T3$, T4$
  9. Set xD = CreateObject("Scripting.Dictionary")
  10. Arr = Range(Cells(Rows.Count, 1).End(xlUp), Cells(1, 115))
  11. For x = 2 To UBound(Arr, 1)
  12.     T1 = ""
  13.     For y = 1 To 51
  14.         T1 = T1 & Arr(x, y)
  15.         If Arr(x, y) = "" Then T1 = T1 & "-"
  16.     Next y
  17.     T3 = ""
  18.     For y = 52 To 102
  19.         T3 = T3 & Arr(x, y)
  20.         If Arr(x, y) = "" Then T3 = T3 & "-"
  21.     Next y
  22.     If T1 = T3 Then
  23.         T1 = T1 & T3 & Arr(x, 106)
  24.         T3 = ""
  25.         If Arr(x, 103) = "" Then
  26.            Arr(x, 103) = 1
  27.            xD(T1) = xD(T1) + Arr(x, 103)
  28.         ElseIf Arr(x, 103) <> "" Then
  29.            xD(T1) = xD(T1) + Arr(x, 103) + 1
  30.         End If
  31.         xD(T1 & 105) = xD(T1 & 105) + Arr(x, 105)
  32.     End If
  33. Next x
  34. T1 = "": k = 1
  35. For Each D In xD
  36.     For x = 2 To UBound(Arr, 1)
  37.         T2 = ""
  38.         For y = 1 To 51
  39.             T2 = T2 & Arr(x, y)
  40.             If Arr(x, y) = "" Then T2 = T2 & "-"
  41.         Next y
  42.         T4 = ""
  43.         For y = 52 To 102
  44.             T4 = T4 & Arr(x, y)
  45.             If Arr(x, y) = "" Then T4 = T4 & "-"
  46.         Next y
  47.         If T2 = T4 Then
  48.             T2 = T2 & T4 & Arr(x, 106)
  49.             T4 = ""
  50.             If D = T2 Then
  51.                 k = k + 1
  52.                 Arr(x, 103) = xD(D) - 1
  53.                 Arr(x, 105) = xD(D & 105)
  54.                 If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
  55.                 Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
  56.                      For y = 1 To UBound(Arr, 2)
  57.                          Arr(k, y) = Arr(x, y)
  58.                          If Arr(k, 103) = 0 Then Arr(k, 103) = ""
  59.                          If Arr(k, 105) = 0 Then Arr(k, 105) = ""
  60.                      Next y
  61.                 Exit For
  62.                 End If
  63.             End If
  64.         End If
  65.     Next x
  66. Next D
  67. T2 = "": Set xD = Nothing
  68. Sheets(2).Range("A1").Resize(k - 1, UBound(Arr, 2)) = ""
  69. Sheets(2).Range("A1").Resize(k - 1, UBound(Arr, 2)) = Arr
  70. Erase Arr
  71. Application.ScreenUpdating = True
  72. Sheets(2).Select
  73. Rows(2).Select
  74. ActiveWindow.FreezePanes = True
  75. Cells(Rows.Count, 106).End(xlUp).Select
  76. End Sub
複製代碼

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-26 
49#
發表於 2020-10-30 10:41 | 只看該作者
基本概念:
資料表應是"流水表"與"統計表"分開,
1) 流水表: 為所有對戰記錄, 可重覆, 也可累積, 也可將已被統計過的刪除, 減少比對工作及時間,
    勝場為空的, 表示是新記錄, 統計過了填入1, 以免再執行統計時又計一次
2) 統計表: 只留各組合的唯一, 舊組合直接累計, 新組合則新增一筆, 保證不重覆,
    必須有對戰總次數, 及勝場數, 才能換算勝率, 統計完後, 以總對戰數為主,勝率為次排序,
   __過去已有的對戰記錄統計, 須事先手動建立

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
48#
發表於 2020-10-30 10:09 | 只看該作者
回復 43# wei9133
抱歉剛才發現累加勝率有問題 改一下  有控再幫我看一下  感謝


javascript:;

對戰統計 -1030_01.rar (33.82 KB)

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
47#
發表於 2020-10-30 01:29 | 只看該作者
本帖最後由 軒云熊 於 2020-10-30 01:36 編輯

回復 43# wei9133

或著改成這樣 看看 是不是你要的結果  還是說  jcchiang前輩 的才是你要的結果
  1. Public Sub 練習1030()
  2. Sheets(2).Select
  3. Rows(2).Select
  4. ActiveWindow.FreezePanes = False
  5. Application.ScreenUpdating = False
  6. Sheets(2).[a1].CurrentRegion.Clear
  7. Sheets(1).Select
  8. Dim Arr, d, xD, x&, y&, k&, T1$, T2$, T3$, T4$
  9. Set xD = CreateObject("Scripting.Dictionary")
  10. Arr = Range(Cells(Rows.Count, 1).End(xlUp), Cells(1, 115))
  11. For x = 2 To UBound(Arr, 1)
  12.     T1 = ""
  13.     For y = 1 To 51
  14.         T1 = T1 & Arr(x, y)
  15.         If Arr(x, y) = "" Then T1 = T1 & "-"
  16.     Next y
  17.     T3 = ""
  18.     For y = 52 To 102
  19.         T3 = T3 & Arr(x, y)
  20.         If Arr(x, y) = "" Then T3 = T3 & "-"
  21.     Next y
  22.     If T1 = T3 Then
  23.        T1 = T1 & T3 & Arr(x, 106)
  24.        T3 = ""
  25.         If Arr(x, 103) = "" Then
  26.            Arr(x, 103) = 1
  27.            xD(T1) = xD(T1) + Arr(x, 103)
  28.         ElseIf Arr(x, 103) <> "" Then
  29.            xD(T1) = xD(T1) + Arr(x, 103)
  30.         End If
  31.         xD(T1 & 105) = xD(T1 & 105) + Arr(x, 105)
  32.     End If
  33. Next x
  34. T1 = "": T3 = ""
  35. For Each d In xD
  36.     For x = UBound(Arr, 1) To 2 Step -1
  37.         T2 = ""
  38.         For y = 1 To 51
  39.             T2 = T2 & Arr(x, y)
  40.             If Arr(x, y) = "" Then T2 = T2 & "-"
  41.         Next y
  42.         T4 = ""
  43.         For y = 52 To 102
  44.             T4 = T4 & Arr(x, y)
  45.             If Arr(x, y) = "" Then T4 = T4 & "-"
  46.         Next y
  47.         If T2 = T4 Then
  48.             T2 = T2 & T4 & Arr(x, 106)
  49.             T4 = ""
  50.             If d = T2 Then
  51.                 E = E + 1
  52.                 If E = 1 Then
  53.                    If Arr(x, 103) > 0 Then Arr(x, 103) = xD(d)
  54.                    If Arr(x, 103) <= 1 Then Arr(x, 103) = ""
  55.                 Else
  56.                     Arr(x, 103) = xD(d) - 1
  57.                     If Arr(x, 103) < 0 Then Arr(x, 103) = Arr(x, 103) * -1
  58.                 End If
  59.                 Arr(x, 105) = xD(d & 105)
  60.                 If xD(d & 105) = 0 Then Arr(x, 105) = ""
  61.             End If
  62.         End If
  63.     Next x
  64.     E = 0
  65. Next d
  66. T2 = "": T4 = "": d = "": k = 1
  67. Set xD = Nothing
  68. For x = 2 To UBound(Arr, 1)
  69.     If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
  70.     Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
  71.         k = k + 1
  72.         For y = 1 To UBound(Arr, 2)
  73.             Arr(k, y) = Arr(x, y)
  74.         Next y
  75.     End If
  76. Next x
  77. T2 = "": T4 = ""
  78. Sheets(2).Range("A1").Resize(k, UBound(Arr, 2)) = ""
  79. Sheets(2).Range("A1").Resize(k, UBound(Arr, 2)) = Arr
  80. Erase Arr
  81. Application.ScreenUpdating = True
  82. Sheets(2).Select
  83. Rows(2).Select
  84. ActiveWindow.FreezePanes = True
  85. Cells(Rows.Count, 106).End(xlUp).Select
  86. End Sub
複製代碼

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
46#
發表於 2020-10-30 01:10 | 只看該作者
回復 43# wei9133

有空幫我看一下 是不是這樣  如果有問題 請告訴我問題出在哪裡 感謝
javascript:;

對戰統計 -1030.rar (32.61 KB)

TOP

        靜思自在 : 一個缺口的杯子，如果換一個角度看它，它仍然是圓的。
1234567
返回列表 上一主題