1234567
返回列表 上一主題 發帖

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

jcchiang

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

回復 44# wei9133

1.那段程式我執行沒有問題(只是清除計數資料,新的程式已不需要)
2.只要是只有1列的維持原資料
   第二列開始,除勝率欄位數值累加,每列再加1(第一列不加)
僅1列無其他相同者 (該格勝率為 "3")
總共勝4場，合併後勝率欄標記為 3場
-->1列的維持原資料

僅1列無其他相同者 (該格勝率為 "空")
總共勝1場，合併後勝率欄標記為 空場
-->1列的維持原資料

共2列相同 勝率為 "2","空"
總共勝4場，合併後勝率欄標記為 3場
-->2列以上("2"+"(0+1)"=3)

共2列相同 勝率為 "空","空"
總共勝2場，合併後勝率欄標記為 1場
-->2列以上("0"+"(0+1)"=1)

共2列相同 勝率為 "2","1"
總共勝5場，合併後勝率欄標記為 4場
-->2列以上("2"+"(1+1)"=4)

共3列相同 勝率為 "2","空","1"
總共勝6場，合併後勝率欄標記為 5場
-->2列以上("2"+"(0+1)","(1+1)"=5)

共4列相同 勝率為 "7","空","3","空"
總共勝14場，合併後勝率欄標記為 13場
-->2列以上("7"+"(0+1)"+"(3+1)"+"(0+1)"=13)
如果還是不對,請寫計算公式(只寫幾場很難理解)

Sub ex5()
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   '字典內查無該條件
      d(AA) = Application.Transpose(Application.Transpose(ar(i, 1).Resize(, 115)))
   Else
      a = Application.Transpose(Application.Transpose(d(AA)))   '將字典資料取出
      a(103) = a(103) + ar(i, 103) + 1 '第二筆以上勝場都多加1
      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)) '將字典資料列出
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 
44#
發表於 2020-10-28 13:04 | 只看該作者
回復  wei9133

1.資料位置放置第二個sheet,請自行修改放置位置
2.勝場計算方式
-->只有1筆資料,勝場都 ...
jcchiang 發表於 2020-10-22 10:24



    你好，這個執行會發生錯誤



勝場計算方式
-->只有1筆資料,勝場都不變動
-->2筆以上資料,所有的"空"都算增加1場,有值的直接累加

有值的應該是該值+1
(因為該列本身就是1)
可以看看#41的枚舉

        你們的理解應該都是該列不計數，勝場就是總勝數
        但這樣就不可能出現勝率為空的格子了
        因為每格至少應該都要是1。

        不過這個問題可以透過我改變統計方式解決，不過上面會發生錯誤的部分要先解決

TOP

wei9133

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

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

javascript:;
軒云熊 發表於 2020-10-25 01:20



        你好，應該不對
    執行完只贏一場的都被刪掉了
    你幫我看一下#41你是否能夠理解
       
        合併前每列都已經視為1了(勝率無值的狀況)
       
        應該這樣講，勝率無值為1，有值就加上去你把勝率那格內的數字一律+1
        最後把總數加起來-1
        (-1是因為該列自己就是1)
       

        目前有3列一樣 (這裡已經1~102跟106設定為一樣了)
        勝率格分別為
          
        第一列勝率"空" = 這列總共勝1場
        第二列勝率"2"  = 這列總共勝3場
        第三列勝率"空" = 這列總共勝1場
       
    這三列要合併，所以總共是贏了5場
        留下一列，勝場填入4
        (還有一場就是留下的那一列)
       
        ;======================================

        另一個情況
        全部找完就只有這一列，無另一列長得一樣的
        所以變成
       
        第一列勝率"空" = 這列總共勝1場
       
        沒得合併
        留下一列，勝場不填
        (因為本就無值)
       
        ;======================================

        全部找完就只有這一列，無另一列長得一樣的
        所以變成
       
        第一列勝率"3" = 這列總共勝4場
       
        沒得合併
        留下一列，勝場填3
        (留下這一列為1，勝場寫3)
       
        其實勝場應該理解為多贏的次數
       
       
        你們的理解應該都是該列不計數，勝場就是總勝數
        但這樣就不可能出現勝率為空的格子了
        因為每格至少應該都要是1。
        而我在打資料的時候已經把該列視為1了
        出現該列就是勝1場，有再贏再+1在勝場上面
        所以每列的勝場該格的數字數其實未包含自己本身，合併的時候就要把他加上去

TOP

wei9133

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


      
這的確是同一對戰，我目前沒辦法統計到這麼細，所以才會各自填上勝跟敗場
        因為有分我去打跟被打的狀況，我就是統計贏跟輸而已
        一個一個截圖，然後把資料打進excel裡
       
        因為要打的時候會用excel去篩選敵對方條件，然後去打，打贏在勝場+1，打輸在敗場+1
        然後敗場多了再用篩選去找相對的部分，把兩邊的數字換過來
       
        基本上這個紀錄表著重在打贏的部分，比較麻煩的部分在於敵對方有些是課金英雄
        所以會出現僅有幾場勝率但敗率很高的列，這個就沒得反轉了

       
        回到主題
        這張表是拿來參考敵對方出陣時我要出甚麼組合才有較高勝率
       
        組合1--a/b/d/f/h-人類 -- 勝5敗3
        組合2--b/d/e/f/g-人類 -- 勝3敗5
        理論上來講，若攻守雙方組合中沒有含我沒有的課金英雄，我會留存勝率高的那組
        也就是組合1，然後碰到對方出陣組合2就拿組合1去打
       
        但因為有課金英雄存在這個就會複雜很多
        因為我沒有那個英雄，就只能登記組合2
        雖然敗場比勝場高，但是我只有組合2可以出
       
        所以目前只能這樣登記而已

TOP

wei9133

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

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

幾 ...
jcchiang 發表於 2020-10-22 08:22



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

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

你好，抱歉現在才回復

2場(勝率為"3","空")合併勝率??  
總共勝5場，合併後勝率欄標記為 4場

3場(勝率為"3","空","空")合併勝率??  
總共勝6場，合併後勝率欄標記為 5場

3場(勝率為"空","空","空")合併勝率??  
總共勝3場，合併後勝率欄標記為 2場

3場(勝率為"3","1","空")合併勝率??     
總共勝7場，合併後勝率欄標記為 6場

4場(勝率為"空","3","1","空")合併勝率??
總共勝7場，合併後勝率欄標記為 6場

以下追加，看能否理解

僅1列無其他相同者 (該格勝率為 "3")
總共勝4場，合併後勝率欄標記為 3場

僅1列無其他相同者 (該格勝率為 "空")
總共勝1場，合併後勝率欄標記為 空場

共2列相同 勝率為 "2","空"
總共勝4場，合併後勝率欄標記為 3場

共2列相同 勝率為 "空","空"
總共勝2場，合併後勝率欄標記為 1場

共2列相同 勝率為 "2","1"
總共勝5場，合併後勝率欄標記為 4場

共3列相同 勝率為 "2","空","1"
總共勝6場，合併後勝率欄標記為 5場

共4列相同 勝率為 "7","空","3","空"
總共勝14場，合併後勝率欄標記為 13場

以上都是合併完後僅留一列

只有一場是否勝率欄位都不變
沒有2個相同的列勝率欄不變無誤

多場的只要勝率為空的不管幾場都只算1場勝場,其餘勝率欄有值的直接累加值

登記過的一列就是一，後面勝率欄有值就代表登記的當下有2個一樣的組合獲勝
因為登記不見得是同一天，所以才會出現
同樣的列但勝率不同的狀況，這個時候就需要合併
先前就是都手工合併

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-6-7 
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

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-6-7 
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-6-7 
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

准提部林

帖子
2822 
主題
10 
精華
0 
積分
2878 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-7-6 
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

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

        靜思自在 : 好事要提得起，是非要放得下，成就別人即是成就自己。
1234567
返回列表 上一主題