1234567
返回列表 上一主題 發帖

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

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
31# 跳轉到 »
發表於 2020-10-21 08:26 | 只看該作者
回復 29# wei9133

勝率計算是否為沒有重複的就不多加1場嗎??
因為你的勝場算法都不一樣
以你在#30樓的貼圖
人類4場勝率為(1,2,空,空),勝率應為1+2+1+1=5保留再加1,所以為6
但力量英雄2場勝率為(空,3),勝率應為1+3=4保留再加1,所以為5,但給的正確勝率卻為3

(#23樓:而勝場部份的值則分別為3、空格、1，敗場的值則為1、空格、空格
  算出來合併的勝場欄位應為"6"，敗場則為"1"
   算法是這樣的，假設3那格保留，而空格代表勝1場，勝場填入1的實際上是"當列"加"勝1場"
   所以加出來是"6")
勝場(3,空,1)=6,如果以空為1,實際也是5,多的1場不就是而外增加的嗎??

另外資料放置其他Sheet是不去改變原有資料以便驗證,而且程式註解也有寫放置於第二個Sheet
如要改放於其他位置或做法,程式中都有註解,請自行微調,謝謝!!

TOP

軒云熊

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

你把 jcchiang前輩的 以下這段改一下 看看 是不是你要的結果

Sub ex3()
Dim d As Object, ar As Object, r
Dim i%, AA$, a
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
Set ar = Sheets(1).[a1].CurrentRegion

For i = 1 To ar.Rows.Count
   AA = Join(Application.Transpose(Application.Transpose(ar(i, 1).Resize(, 102))), ",") & "," & ar(i, 106) '建立判斷條件
   If Not d.exists(AA) Then   '字典內查無該條件
      a = Application.Transpose(Application.Transpose(ar(i, 1).Resize(, 115)))
      If a(103) = "" Then a(103) = 1 '勝場空白填入1
      d(AA) = a '將資料放回字典
   Else
      a = Application.Transpose(Application.Transpose(d(AA)))   '將字典資料取出
      If ar(i, 103) = "" Then a(103) = a(103) + 1 Else a(103) = a(103) + ar(i, 103) '勝場空白勝場累加1,不是空白則將欄位值相加
      a(105) = a(105) + ar(i, 105) '敗局累加
      For Each r In Array(104, 107, 109, 115) '將備註,DC,DE,DK欄位資料合併
         If a(r) <> "" And ar(i, r) <> "" Then '如果字典與欄位都有資料,使用","相連
            a(r) = a(r) & "," & ar(i, r)
         ElseIf a(r) = "" And ar(i, r) <> "" Then '如果字典資料為空白,欄位是有資料的,使用欄位資料
            a(r) = ar(i, r)
         End If
      Next
      d(AA) = a   '將資料放回字典
   End If
Next
With Sheets(2)  '在第二個Sheet填入資料
.[a1].CurrentRegion.Clear '清除Sheet資料
.[a1].Resize(d.Count, 115) = Application.Transpose(Application.Transpose(d.items)) '將字典資料列出
'For Each r In .Range(.[cy2], .[cy2].End(4))  '保留勝場+1
'   r.Value = r.Value + 1
'Next
End With
Set d = Nothing
Application.ScreenUpdating = True
End Sub

TOP

wei9133

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

30F的確是我算錯了
力量英雄應該是4

(#23樓:而勝場部份的值則分別為3、空格、1，敗場的值則為1、空格、空格
  算出來合併的勝場欄位應為"6"，敗場則為"1"
   算法是這樣的，假設3那格保留，而空格代表勝1場，勝場填入1的實際上是"當列"加"勝1場"
   所以加出來是"6")

第二段的部分你的理解是對的

勝場(3,空,1)=6,如果以空為1,實際也是5,多的1場不就是而外增加的嗎??
這個其實我沒看懂

我這樣看你能不能理解
紀錄出來的當列，本身就代表那次的勝場，當我統計到一模一樣的對戰，就在勝場處+1
所以每一列都代表了1，而勝場是另外加上去的，才會變成處理到該格若該格有值要+1上去
勝率那格若無另外的數值，整列視為1

===================分隔線======================
我拿了你在28F提供的程式碼下去執行
圖1

圖一的第一跟第二列勝率欄位都是0，代表各自當列的勝場，而這兩個結構都一樣
所以運行出來應該是
合併起來，勝率寫1  (實際上是贏2場沒錯，但自己這一列就代表了一場，所以勝率那格只會寫1)
第三行是獨自自己一個，沒有相同列，所以就只有保留，至於勝率因為該格是0，且只有它自己，所以應該留空
我想執行出來的結果
圖2

===============================================
實際執行出來的結果
圖3

我執行的結果出來感覺是，勝率那格無論是空還是1都會被視為1
但實際上應該是該列等於1，勝率那格若有數字，
且該列要被併到另一列的話，就要以該格數字加上自己這一列代表的1

而是勝率那格是空值且無相同列可合併的，保留該列，勝率那格也就還是0
(因為贏的依舊只有一場，而那場就是該列本身)

==============================================
若這樣真的很難被理解的話，我可以改變統計方式
整列不代表任何數字，贏的次數全寫在勝率那裏
這個組合贏一次就寫1，贏兩次就寫2
這樣就不會有要計算本身列為1的問題了

你的整個程式我再研究看看要改哪裡才會符合我的需求
感謝兩位

圖1.png (16.24 KB)

圖1.png

TOP

wei9133

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

你把 jcchiang前輩的 以下這段改一下 看看 是不是你要的結果

Sub ex3()
Dim d As Ob ...
軒云熊 發表於 2020-10-21 21:56

你好
因為測試完
勝率那格無論是空還是1都會被視為1，但實際上應該是空為1，寫1實際應為2 (要被合併的狀況下)
而不被合併的狀況下空就是空，該格不應有值 (因為該列自己就是1)
所以只註解掉迴圈加1的部分還是沒用的
勝率那格有值的正確了，空的就會有問題，反之亦然
所以你改的這樣還是不太對
感謝你了

TOP

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
35#
發表於 2020-10-22 08:22 | 只看該作者
回復 33# wei9133

#33
有2場一樣(勝率欄為"空","空")合併勝率為1
只有1場(勝率欄為"空")勝率為"空"

幾種狀況如何計算
2場(勝率為"3","空")合併勝率??(是否為4)
3場(勝率為"3","空","空")合併勝率??(是否為4)
3場(勝率為"空","空","空")合併勝率??(是否為1)
3場(勝率為"3","1","空")合併勝率??(是否為5)
4場(勝率為"空","3","1","空")合併勝率??(是否為5)
只有一場是否勝率欄位都不變
多場的只要勝率為空的不管幾場都只算1場勝場,其餘勝率欄有值的直接累加值

TOP

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
36#
發表於 2020-10-22 10:24 | 只看該作者
回復 33# wei9133

1.資料位置放置第二個sheet,請自行修改放置位置
2.勝場計算方式
-->只有1筆資料,勝場都不變動
-->2筆以上資料,所有的"空"都算增加1場,有值的直接累加

Sub ex4()
Dim d As Object, ar As Object, r
Dim i%, AA$, a
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
Set ar = Sheets("對戰統計").[a1].CurrentRegion

For i = 1 To ar.Rows.Count
   AA = Join(Application.Transpose(Application.Transpose(ar(i, 1).Resize(, 102))), ",") & "," & ar(i, 106) '建立判斷條件
   If Not d.exists(AA) Then   '字典內查無該條件
      a = Application.Transpose(Application.Transpose(ar(i, 1).Resize(, 115)))
      ReDim Preserve a(1 To UBound(a) + 2)
      If a(103) = "" Then a(UBound(a) - 1) = 1 '紀錄勝場空白數
      a(UBound(a)) = 1 '紀錄筆數
      d(AA) = a '將資料放回字典
   Else
      a = Application.Transpose(Application.Transpose(d(AA)))   '將字典資料取出
      If ar(i, 103) = "" Then a(UBound(a) - 1) = a(UBound(a) - 1) + 1 Else a(103) = a(103) + ar(i, 103) '勝場空白紀錄累加1,不是空白則將欄位值相加
      a(UBound(a)) = a(UBound(a)) + 1 ''紀錄筆數+1
      a(105) = a(105) + ar(i, 105) '敗局累加
      For Each r In Array(104, 107, 109, 115) '將備註,DC,DE,DK欄位資料合併
         If a(r) <> "" And ar(i, r) <> "" Then '如果字典與欄位都有資料,使用","相連
            a(r) = a(r) & "," & ar(i, r)
         ElseIf a(r) = "" And ar(i, r) <> "" Then '如果字典資料為空白,欄位是有資料的,使用欄位資料
            a(r) = ar(i, r)
         End If
      Next
      d(AA) = a   '將資料放回字典
   End If
Next
With Sheets(2)  '在第二個Sheet填入資料
.[a1].CurrentRegion.Clear '清除Sheet資料
.[a1].Resize(d.Count, UBound(a)) = Application.Transpose(Application.Transpose(d.items)) '將字典資料列出
For Each r In .Range(.[cy2], .[cy65535].End(3))
   If r.Offset(, 14) > 1 And r.Offset(, 13) > 0 Then r.Value = r.Value + 1 '2筆資料以上且有勝場為"空"的勝場+1
Next
i = .[a1].CurrentRegion.Columns.Count
.Range(Cells(1, i - 1), Cells(65535, i).End(3)).Clear '清除空白&資料計算筆數
End With
Set d = Nothing
Application.ScreenUpdating = True
End Sub

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-29 
37#
發表於 2020-10-23 10:18 | 只看該作者
組合1--a/b/d/f/h-人類(勝方)   組合2--b/d/e/f/g-人類(敗方) --- 共出現5次
組合2--b/d/e/f/g-人類(勝方)   組合1--a/b/d/f/h-人類(敗方) --- 共出現3次
雖然左右對調, 但應算同一組合對戰吧!

組合1--a/b/d/f/h-人類 -- 勝5敗3
組合2--b/d/e/f/g-人類 -- 勝3敗5

這勝敗率如何計算???

TOP

軒云熊

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

回復 34# wei9133

請問你要的結果是不是這樣
先左右比對 若是 1~51  跟 52~102 相同時 + 星象106 此時(勝率 =  "" 或 敗局 = ""  本身就是 =1 或著 =-1 ?)  當作尋找比對的目標  
再尋找比對上下 1~102 + 星象106 若相同時  在看 103勝率  跟  105敗局 進行累加
累加後的數值要在 合併該列的順序上
合併該列的順序是   先107 A  若 =""  就合併在 109  X   若 ="" 就合併在   115暫存   若 =""  就合併在  104備註
還是說 就像 jcchiang 前輩 跟 准提大大 所說的 這樣複雜的組合算法?
或著能否簡單明瞭就好 我實在不太明白抱歉...小弟數學不好

TOP

軒云熊

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

有空幫我看一下 是不是這樣的結果 謝謝

javascript:;

對戰統計 -1025.rar (699.95 KB)

TOP

軒云熊

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

回復 34# wei9133

感覺敗局 怪怪的 所以改了一下 有空幫我看一下 感謝 跑的速度慢了一些 不知如何加快速度.....
  1. Public Sub 練習1025()
  2. Application.ScreenUpdating = False
  3. Sheets(1).Select
  4. Sheets(2).[a1].CurrentRegion.Clear
  5. Dim Arr, D, xD, xD1, x&, y&, k&, T1$, T2$, T3$, T4$
  6. Set xD = CreateObject("Scripting.Dictionary")
  7. Set xD1 = CreateObject("Scripting.Dictionary")
  8. Arr = Range(Cells(Rows.Count, 1).End(xlUp), Cells(1, 115))
  9. For x = 2 To UBound(Arr, 1)
  10.     T1 = ""
  11.     For y = 1 To 51
  12.         T1 = T1 & Arr(x, y)
  13.         If Arr(x, y) = "" Then T1 = T1 & "-"
  14.     Next y
  15.     T3 = ""
  16.     For y = 52 To 102
  17.         T3 = T3 & Arr(x, y)
  18.         If Arr(x, y) = "" Then T3 = T3 & "-"
  19.     Next y
  20.     If T1 = T3 Then
  21.        T1 = T1 & T3 & Arr(x, 106)
  22.        T3 = ""
  23.         If Arr(x, 103) = "" Then
  24.            Arr(x, 103) = 1
  25.            xD(T1) = xD(T1) + Arr(x, 103)
  26.         ElseIf Arr(x, 103) <> "" Then
  27.            xD(T1) = xD(T1) + Arr(x, 103)
  28.         End If
  29.         xD1(T1) = xD1(T1) + Arr(x, 105)
  30.     End If
  31. Next x
  32. T1 = "": T3 = ""
  33. For Each D In xD
  34.     For x = UBound(Arr, 1) To 2 Step -1
  35.         T2 = ""
  36.         For y = 1 To 51
  37.             T2 = T2 & Arr(x, y)
  38.             If Arr(x, y) = "" Then T2 = T2 & "-"
  39.         Next y
  40.         T4 = ""
  41.         For y = 52 To 102
  42.             T4 = T4 & Arr(x, y)
  43.             If Arr(x, y) = "" Then T4 = T4 & "-"
  44.         Next y
  45.         If T2 = T4 Then
  46.             T2 = T2 & T4 & Arr(x, 106)
  47.             T4 = ""
  48.             If D = T2 Then
  49.                 Arr(x, 103) = xD(D)
  50.                 Arr(x, 105) = xD1(D)
  51.             End If
  52.         End If
  53.     Next x
  54. Next D
  55. T2 = "": T4 = "": D = "": k = 1
  56. For x = 2 To UBound(Arr, 1)
  57.     If Arr(x, 103) <> "" Or Arr(x, 105) <> "" Then
  58.         If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
  59.         Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
  60.             k = k + 1
  61.         End If
  62.         For y = 1 To UBound(Arr, 2)
  63.             If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
  64.             Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
  65.                 Arr(k, y) = Arr(x, y)
  66.             End If
  67.         Next y
  68.     End If
  69. Next x
  70. Set xD = Nothing
  71. Set xD1 = Nothing
  72. Sheets(2).Range("A1").Resize(k, UBound(Arr, 2)) = ""
  73. Sheets(2).Range("A1").Resize(k, UBound(Arr, 2)) = Arr
  74. Erase Arr
  75. Sheets(2).Select
  76. Application.ScreenUpdating = True
  77. End Sub
複製代碼

TOP

        靜思自在 : 要批評別人時，先想想自己是否完美無缺。
1234567
返回列表 上一主題