vba的篩選功能 (取消部分篩選) - Excel程式區

帖子: 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

wei9133

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

帖子: 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

jcchiang

中學生 Rank: 2

帖子: 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

軒云熊

中學生 Rank: 2

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

46^#

發表於 2020-10-30 01:10 | 只看該作者

回復 43# wei9133

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

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

TOP

軒云熊

中學生 Rank: 2

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

47^#

發表於 2020-10-30 01:29 | 只看該作者

本帖最後由軒云熊於 2020-10-30 01:36 編輯

回復 43# wei9133

或著改成這樣看看是不是你要的結果還是說 jcchiang前輩的才是你要的結果

Public Sub 練習1030()
Sheets(2).Select
Rows(2).Select
ActiveWindow.FreezePanes = False
Application.ScreenUpdating = False
Sheets(2).[a1].CurrentRegion.Clear
Sheets(1).Select
Dim Arr, d, xD, x&, y&, k&, T1$, T2$, T3$, T4$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range(Cells(Rows.Count, 1).End(xlUp), Cells(1, 115))
For x = 2 To UBound(Arr, 1)
T1 = ""
For y = 1 To 51
T1 = T1 & Arr(x, y)
If Arr(x, y) = "" Then T1 = T1 & "-"
Next y
T3 = ""
For y = 52 To 102
T3 = T3 & Arr(x, y)
If Arr(x, y) = "" Then T3 = T3 & "-"
Next y
If T1 = T3 Then
T1 = T1 & T3 & Arr(x, 106)
T3 = ""
If Arr(x, 103) = "" Then
Arr(x, 103) = 1
xD(T1) = xD(T1) + Arr(x, 103)
ElseIf Arr(x, 103) <> "" Then
xD(T1) = xD(T1) + Arr(x, 103)
End If
xD(T1 & 105) = xD(T1 & 105) + Arr(x, 105)
End If
Next x
T1 = "": T3 = ""
For Each d In xD
For x = UBound(Arr, 1) To 2 Step -1
T2 = ""
For y = 1 To 51
T2 = T2 & Arr(x, y)
If Arr(x, y) = "" Then T2 = T2 & "-"
Next y
T4 = ""
For y = 52 To 102
T4 = T4 & Arr(x, y)
If Arr(x, y) = "" Then T4 = T4 & "-"
Next y
If T2 = T4 Then
T2 = T2 & T4 & Arr(x, 106)
T4 = ""
If d = T2 Then
E = E + 1
If E = 1 Then
If Arr(x, 103) > 0 Then Arr(x, 103) = xD(d)
If Arr(x, 103) <= 1 Then Arr(x, 103) = ""
Else
Arr(x, 103) = xD(d) - 1
If Arr(x, 103) < 0 Then Arr(x, 103) = Arr(x, 103) * -1
End If
Arr(x, 105) = xD(d & 105)
If xD(d & 105) = 0 Then Arr(x, 105) = ""
End If
End If
Next x
E = 0
Next d
T2 = "": T4 = "": d = "": k = 1
Set xD = Nothing
For x = 2 To UBound(Arr, 1)
If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
k = k + 1
For y = 1 To UBound(Arr, 2)
Arr(k, y) = Arr(x, y)
Next y
End If
Next x
T2 = "": T4 = ""
Sheets(2).Range("A1").Resize(k, UBound(Arr, 2)) = ""
Sheets(2).Range("A1").Resize(k, UBound(Arr, 2)) = Arr
Erase Arr
Application.ScreenUpdating = True
Sheets(2).Select
Rows(2).Select
ActiveWindow.FreezePanes = True
Cells(Rows.Count, 106).End(xlUp).Select
End Sub

複製代碼

TOP

軒云熊

中學生 Rank: 2

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

48^#

發表於 2020-10-30 10:09 | 只看該作者

回復 43# wei9133
抱歉剛才發現累加勝率有問題改一下有控再幫我看一下感謝

javascript:;

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

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2848
主題: 10
精華: 0
積分: 2903
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2026-7-25

49^#

發表於 2020-10-30 10:41 | 只看該作者

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

TOP

軒云熊

中學生 Rank: 2

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

50^#

發表於 2020-10-30 20:30 | 只看該作者

回復 49# 准提部林

感謝準大指導不知道這樣改是不是有接近準大說的方法
看起來還是有差很多結果與 jcchiang前輩的不同不知如何修改...

Public Sub 練習1030_02()
Sheets(2).Select
Rows(2).Select
ActiveWindow.FreezePanes = False
Application.ScreenUpdating = False
Sheets(2).[a1].CurrentRegion.Clear
Sheets(1).Select
Dim Arr, D, xD, x&, y&, k&, T1$, T2$, T3$, T4$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range(Cells(Rows.Count, 1).End(xlUp), Cells(1, 115))
For x = 2 To UBound(Arr, 1)
T1 = ""
For y = 1 To 51
T1 = T1 & Arr(x, y)
If Arr(x, y) = "" Then T1 = T1 & "-"
Next y
T3 = ""
For y = 52 To 102
T3 = T3 & Arr(x, y)
If Arr(x, y) = "" Then T3 = T3 & "-"
Next y
If T1 = T3 Then
T1 = T1 & T3 & Arr(x, 106)
T3 = ""
If Arr(x, 103) = "" Then
Arr(x, 103) = 1
xD(T1) = xD(T1) + Arr(x, 103)
ElseIf Arr(x, 103) <> "" Then
xD(T1) = xD(T1) + Arr(x, 103) + 1
End If
xD(T1 & 105) = xD(T1 & 105) + Arr(x, 105)
End If
Next x
T1 = "": k = 1
For Each D In xD
For x = 2 To UBound(Arr, 1)
T2 = ""
For y = 1 To 51
T2 = T2 & Arr(x, y)
If Arr(x, y) = "" Then T2 = T2 & "-"
Next y
T4 = ""
For y = 52 To 102
T4 = T4 & Arr(x, y)
If Arr(x, y) = "" Then T4 = T4 & "-"
Next y
If T2 = T4 Then
T2 = T2 & T4 & Arr(x, 106)
T4 = ""
If D = T2 Then
k = k + 1
Arr(x, 103) = xD(D) - 1
Arr(x, 105) = xD(D & 105)
If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
For y = 1 To UBound(Arr, 2)
Arr(k, y) = Arr(x, y)
If Arr(k, 103) = 0 Then Arr(k, 103) = ""
If Arr(k, 105) = 0 Then Arr(k, 105) = ""
Next y
Exit For
End If
End If
End If
Next x
Next D
T2 = "": Set xD = Nothing
Sheets(2).Range("A1").Resize(k - 1, UBound(Arr, 2)) = ""
Sheets(2).Range("A1").Resize(k - 1, UBound(Arr, 2)) = Arr
Erase Arr
Application.ScreenUpdating = True
Sheets(2).Select
Rows(2).Select
ActiveWindow.FreezePanes = True
Cells(Rows.Count, 106).End(xlUp).Select
End Sub

複製代碼

TOP

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

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]