wei9133

回復  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個一樣的組合獲勝
因為登記不見得是同一天，所以才會出現
同樣的列但勝率不同的狀況，這個時候就需要合併
先前就是都手工合併

wei9133

回復 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可以出
       
        所以目前只能這樣登記而已

wei9133

回復  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在勝場上面
        所以每列的勝場該格的數字數其實未包含自己本身，合併的時候就要把他加上去

wei9133

回復  wei9133

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

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

下載 (44.23 KB)

2020-10-28 12:56

下載 (48.55 KB)

2020-10-28 12:56

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

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

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

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

jcchiang

回復 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

軒云熊

回復 43# wei9133

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

軒云熊

回復 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

複製代碼

軒云熊

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


javascript:;

准提部林

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

軒云熊

回復 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

複製代碼