麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] vba的篩選功能 (取消部分篩選) [打印本頁]

作者: wei9133 時間: 2020-10-6 00:33 標題: vba的篩選功能 (取消部分篩選)

如何取消部分已被篩選的選項
篩選總共分成前後區段，分別是1~49 & 51~99，50的位置是中間分格
需求是在不影響51~99被篩選的部分，將1~49全部改為"全部"就是原始未篩選的狀態，反之亦然。

sub 篩選前端  ()
Dim var_min, var_max,i, j, s As Integer
var_min = 1  '前半段起
var_max = 49 '前半段迄
For i = var_min To var_max
i = i + 1
Selection.AutoFilter Field:=i
Next i
End Sub

sub 篩選後端  ()
Dim var_min, var_max,i, j, s As Integer
var_min = 51  '後半段起
var_max = 99  '後半段迄
For i = var_min To var_max
i = i + 1
Selection.AutoFilter Field:=i
Next i
End Sub

由錄製可以得到，一般的篩選指令是
Selection.AutoFilter Field:=5, Criteria1:="W" '將第5欄篩選為W
但是選擇取消該欄位的篩選，選擇全部則只會是
Selection.AutoFilter Field:=i
'從錄製看起來沒有給後面這串指定值就是全部了
'將該格篩選為"全部"

所以有了上面的程式碼，但看起來是沒有效果的。
想請問取消篩選的指令是? (Criteria1:= ?)
還有如果不用迴圈有直接選取範圍的方法嗎?
或是只能用迴圈，有用文字而非欄位數的方法?
像目前1~49其實是A~AX，51~99其實是AY~CU
可以直接指定文字下去迴圈嗎?
畢竟直接看到的是文字，比再去換算數字直觀。

作者: ikboy 時間: 2020-10-6 10:03

同一頁內要顯示兩板塊篩選, 要用ListObjects, 樓主最好將模擬效果附件上載上來。

作者: wei9133 時間: 2020-10-6 20:25

本帖最後由 wei9133 於 2020-10-6 20:28 編輯

回復 2# ikboy

如附件
[attach]32570[/attach]

還有，忘了講，版本是 excel2003
麻煩了!
我是沒看懂你說的，我是想不動已被篩選的部分(指定範圍)
將另外剩下的被篩選部分全部重置為全部狀態(未被篩選過的狀態)

作者: ikboy 時間: 2020-10-6 21:02

沒看到你要求的效果, 請手動模擬上來。

作者: wei9133 時間: 2020-10-7 00:04

本帖最後由 wei9133 於 2020-10-7 00:13 編輯

回復 4# ikboy
[attach]32574[/attach]
附件右半邊已篩選，想在不動到右半邊已篩選的條件
將左半邊被篩選的條件重置為全部
[attach]32573[/attach]

A 已篩選 V
B 已篩選 W
F 已篩選空格
W 已篩選 W
X 已篩選空格

反方向亦然 (左半選取狀況下，右半邊全部重置為原始未篩選狀態)

;===============================================
[attach]32575[/attach]
[attach]32576[/attach]
上面這個AY~CU要篩選的已經確定了
就是要把A~AW的全部重置為未篩選狀態
[attach]32577[/attach]
[attach]32578[/attach]

作者: ikboy 時間: 2020-10-7 11:24

在同一頁及相同行將A-AW列, AY-CU列視為兩個不同板塊作篩選處理是不行的, 簡單的舉例: A2篩選後是顯示資料,AY2篩選後是不顯示資料, 那第2行到底要顯示或隱藏!!
折衷辦法分頁, 並排。附件我手動做的, 看看這思路行不。

作者: 軒云熊 時間: 2020-10-7 12:28

回復 6# ikboy
請問你的意思是篩選後的結果再篩選一次或著更多次嗎?

作者: ikboy 時間: 2020-10-7 13:23

回復 ikboy
請問你的意思是篩選後的結果再篩選一次或著更多次嗎?
軒云熊發表於 2020-10-7 12:28

請看樓主在5#回覆, 由其是A~AW 與AY~CU那段,你會明白了。

作者: 軒云熊 時間: 2020-10-7 14:12

本帖最後由軒云熊於 2020-10-7 14:15 編輯

回復 1# wei9133

並排顯示嗎?

Sub 垂直並排顯示加篩選()
Application.ScreenUpdating = False
ActiveWindow.NewWindow '開啟多個相同工作簿
Windows.Arrange ArrangeStyle:=xlVertical '垂直並排顯示
Windows("zz.xls:1").Activate '切換到工作表2
Sheets(2).Cells(51, 1).AutoFilter '篩選工作表2
Sheets(2).Select '點選工作表2
Windows("zz.xls:2").Activate '切換到工作表1
Sheets(1).Cells(1, 1).AutoFilter '篩選工作表1
Application.ScreenUpdating = True
End Sub

複製代碼

作者: wei9133 時間: 2020-10-7 19:26

回復 9# 軒云熊
你好，我沒有測試你的巨集
不過看就知道不對，因為東西是在同一個活頁簿裡
只是分成前面跟後面而已
詳細可以看看上面的附件
應該這樣講
假設有A~Z欄 (實際上更多)
把A~L全部篩選好了
要把M~Z的篩選條件全部清空為預設
大概就只是這樣而已

作者: wei9133 時間: 2020-10-7 19:56

本帖最後由 wei9133 於 2020-10-7 20:00 編輯

回復 6# ikboy

不對，我直接講我要的結果
其實原本就是要把所有相同的行標示出來，然後加總起來
我沒有要拆開他的意思
每一行都是一個對戰紀錄(在附件CZ行有星象)
所以要比對的其實是，是否有A~CV都長得一樣的列(需要包含CZ)，因為不同星象也會有A~CV想的一樣的狀態出現
不過因為還有CW~CY是不會相同的值，所以無法直接比對
現在我是手動把A~AW的挑選出來後，再去一個一個把AY~CU篩選出來，一樣的合併(連星象都一樣的部分)，然後勝場+1
所以想要我在固定A~AW篩選條件的狀況下，去重置AY~CU的篩選條件

還是看不懂的麻煩移駕影片
https://sendvid.com/kvj69nqz
超連弄不出來，請自己複製網址到網址列吧
實際是就是要最後幾秒那個動作而已
只是不只點的那幾個，而是後方全部都點成全部

作者: 軒云熊 時間: 2020-10-7 20:06

本帖最後由軒云熊於 2020-10-7 20:12 編輯

回復 10# wei9133

A~L 原本的資料格式要保留嗎? 還是只保留篩選後的?
M~Z 不做任何動作?
這樣的話 A~L 的格式資料會改變無法復原因為是先刪除 A~L 的資料在貼上篩選後的資料如果是在同一個活頁簿裡
或著直接新增一個新的工作表在把結果貼上 ?
我看一下影片好了 >"<

作者: wei9133 時間: 2020-10-8 00:45

回復 12# 軒云熊
你好
在最初的需求中我沒有要刪任何資料
我是要比對是否有相同的資料(列)
才要固定[左|右]一邊的已篩選條件

應該怎麼說才能讓你理解呢0.0a

A~L 原本的資料格式要保留嗎? 還是只保留篩選後的?
M~Z 不做任何動作?

A~L已經篩選過了，都不要動它
M~Z每一個都把篩選選單拉開來點"全部"
[attach]32583[/attach]

我覺得我們溝通的問題應該出在這個"全部"上面...

感謝你花時間幫我想解決方案 m(_ _)m

作者: jcchiang 時間: 2020-10-8 09:04

回復 13# wei9133

樓主需求的篩選模式在同一sheet是無法執行的(ikboy已經說明了)
如果只是要計算各星象勝率/敗局建議可用比對的
只是無法看出這2各區塊(A~AW)內資料的相關性&勝率/敗局計算方式??

作者: 軒云熊 時間: 2020-10-8 12:24

本帖最後由軒云熊於 2020-10-8 12:31 編輯

回復 13# wei9133
這不是用篩選而是用比對的方式
你看一下是不是這樣?

Public Sub 比對練習()
Application.ScreenUpdating = False
Dim A, B, i, k
k = 1
E = 345
For X = 1 To Cells(1, 1).End(xlDown).Row
A = Range(Cells(X, 49), Cells(X, 1))
B = Range(Cells(X, 99), Cells(X, 51))
For i = 1 To UBound(B, 2)
If A(1, k) = "" Then A(1, k) = "-"
If B(1, i) = "" Then B(1, i) = "-"
f = f & A(1, k)
r = r & B(1, i)
If k <= UBound(A, 2) Then k = k + 1
Next i
k = 1
If f = r Then
Cells(E, 1).Resize(1, 104) = Cells(X, 1).Resize(1, 104).Value
E = E + 1
End If
f = "": r = ""
Next X
Application.ScreenUpdating = True
End Sub

複製代碼

作者: 軒云熊 時間: 2020-10-8 23:20

本帖最後由軒云熊於 2020-10-8 23:21 編輯

回復 13# wei9133

這是修改過的順序是 1~49 與 51~99 相同勝率=1 -> 錄製的排序->錄製的刪除重複
錄製的刪除重複有點怪怪的不過還是可以用我找不到原因刪除後格式還是會存在但數值文字已被刪除
修改範圍後刪除的列位不會往上補 >"< 後來又改回來...不知道為甚麼..呵
影片看起來是這樣不知道是不是你要的我也是順便練習

javascript:;

作者: wei9133 時間: 2020-10-9 00:30

回復 14# jcchiang

其實我實際上就是比對，不過是人工比對
所以才會想要固定一邊的篩選後條件，將另外半邊全部點回原始未被篩選的狀態
這樣方便看另一邊是否有一樣的組合
這張圖表裡面顯示不出敗局，因為敗局是紀錄的時候發現輸了手動填上的
所以實際比對目標應該是
A~CV都長得一模一樣且CZ也一樣的部分
A~CV分別應對勝敗方的出場人物，而CZ是星象(這個參數雙方共用)
A~AW是敗方組合，AY~CU是敗方組合
AX跟CV這兩格出戰人數是勝敗方的出戰人數，以確保未統計錯誤
(正常為5，若錯了有用格式化標出以發現輸入錯誤)

目前我人工統計的流程是
先固定左邊的篩選條件，這樣篩選出來的敗方角色就被固定了 (反之就是固定勝方篩選條件再去挑選敗方角色)
再從右邊挑選條件篩選，發現兩條長的一模一樣的(A~CV & CZ)，確認一下備註(CX)的顏色階級
(有可能A~CV都一樣但ZC是不同的)
[attach]32588[/attach]
(現在看起來短是因為隱藏了中間的部分)
然後把這幾條一樣的勝場(CW)敗場(CY)加起來填到要留下的那一條的勝場(CW)敗場(CY)欄位
(這個時候我會看一下備註決定要留哪一條)
然後把留下之外的其他條刪除。

作者: wei9133 時間: 2020-10-9 00:46

回復 16# 軒云熊
我其實也沒看懂你的東西，只有一個活頁簿的東西怎麼變成兩個了
而且我執行它還報錯了
[attach]32590[/attach]
[attach]32589[/attach]

我要比對的始終在一個活頁簿裡
目前是人工挑選A~CV都長得一模一樣且CZ也一樣的部分
然後加總敗場跟勝場數填入其中一列的該格中留存
剩下刪除

作者: wei9133 時間: 2020-10-9 01:06

本帖最後由 wei9133 於 2020-10-9 01:16 編輯

回復 17# wei9133

我把我具體的操作錄成影片了，看一下或許能懂?

https://sendvid.com/suu270r2

其中整欄直接篩選成V或W的部分因為我已經錄成巨集所以沒有去拉下拉式選單

Sub 篩選為V() '^U
Dim i As Integer
i = ActiveCell.Column '獲取欄位值
Cells(1, i).Select
Selection.AutoFilter Field:=i, Criteria1:="V"
'將該格篩選為"V"
End Sub
Sub 篩選為W() '^I
Dim i As Integer
i = ActiveCell.Column '獲取欄位值
Cells(1, i).Select
Selection.AutoFilter Field:=i, Criteria1:="W"
'將該格篩選為"W"
End Sub
Sub 篩選為空格() '^B
Dim i As Integer
i = ActiveCell.Column '獲取欄位值
Cells(1, i).Select
Selection.AutoFilter Field:=i, Criteria1:="="
'將該格篩選為"空格"
End Sub
Sub 篩選為非空格() 'O
Dim i As Integer
i = ActiveCell.Column '獲取欄位值
Cells(1, i).Select
Selection.AutoFilter Field:=i, Criteria1:="<>"
'將該格篩選為"非空格"
End Sub
Sub 篩選為全選() '^+Q
Dim i As Integer
i = ActiveCell.Column '獲取欄位值
Cells(1, i).Select
Selection.AutoFilter Field:=i ' Criteria1:="<>" ，看起來沒有給後面這串指定值就是全部了
'將該格篩選為"全部"
End Sub

複製代碼

一開始我需要的功能需求其實是這個
在我選完某一邊之後，把另一邊全部由篩選下拉式選單選回"全選"

https://sendvid.com/3ifimegq

所以才會出現這種東西

sub 篩選後端 ()
Sub 篩選後端()
Dim var_min, var_max, i, j, s As Integer
var_min = 51 '後半段起
var_max = 99 '後半段迄
For j = var_min To var_max
j = j + 1
Cells(1, j).Select
Selection.AutoFilter Field:=j
Next j
End Sub

複製代碼

但是這組代碼好像沒用，所以才會來問

作者: 軒云熊 時間: 2020-10-9 09:52

本帖最後由軒云熊於 2020-10-9 10:06 編輯

回復 19# wei9133

你要先把工作表2 刪除再新增一個工作表2在執行工作表2 是複製的內容我沒有動工作表1的內容執行 Module1

Public Sub 多列比對練習()
Sheets(2).Select
Rows("2:2").Select
ActiveWindow.FreezePanes = False '關閉凍結視窗
Application.ScreenUpdating = False
Call 巨集1 '錄製的排序
k = 1
For X = Cells(1, 1).End(xlDown).Row To 2 Step -1
A = Range(Cells(X, 49), Cells(X, 1)) '把1~49內容放到陣列
B = Range(Cells(X, 99), Cells(X, 51)) '把51~99內容放到陣列
For I = 1 To UBound(B, 2) '串聯 "-" 號方便比對
If A(1, k) = "" Then A(1, k) = "-"
If B(1, I) = "" Then B(1, I) = "-"
f = f & A(1, k)
r = r & B(1, I)
If k <= UBound(A, 2) Then k = k + 1
Next I
k = 1
If f = r And f <> "-" Then '若1~49 與 51~99 相同就在勝率欄位輸入"1"並反黃色
Cells(X, 101) = "1"
Cells(X, 101).Interior.Color = RGB(255, 255, 0)
End If
f = "": r = ""
Next X
Call 巨集2 '錄製的刪除重複
Application.ScreenUpdating = True
Rows("2:2").Select
ActiveWindow.FreezePanes = True '開啟凍結視窗
End Sub

複製代碼

作者: 軒云熊 時間: 2020-10-12 04:15

本帖最後由軒云熊於 2020-10-12 04:24 編輯

回復 19# wei9133
把勝率跟敗局改為有重複就加1 有空再幫我看看是不是這樣謝謝

Public Sub 多列比對練習()
Application.ScreenUpdating = False
Dim Arr, i&, t&, A1$, A2$
Arr = Range(Sheets(3).Cells(Rows.Count, 1).End(xlUp), Sheets(3).Cells(2, 100))
ReDim A(LBound(Arr) To UBound(Arr))
'多列比對
For t = 1 To UBound(Arr, 1)
For i = UBound(Arr, 1) To t + 1 Step -1
A1 = 串聯_文字(Application.WorksheetFunction.Index(Arr, t, 0))
A2 = 串聯_文字(Application.WorksheetFunction.Index(Arr, i, 0))
A1 = A1 & Cells(t + 1, 104)
A2 = A2 & Cells(i + 1, 104)
If A1 = A2 Then
Cells(t + 1, 101) = Cells(t + 1, 101) + 1
Cells(i + 1, 101) = Cells(i + 1, 101) + 1
Cells(t + 1, 103) = Cells(t + 1, 103) + 1
Cells(i + 1, 103) = Cells(i + 1, 103) + 1
Cells(t + 1, 104).Interior.Color = RGB(255, 255, 0)
Cells(i + 1, 104).Interior.Color = RGB(255, 255, 0)
End If
Next i
Next t
'刪除重複
For X = 2 To Cells(2, 1).End(xlDown).Row
For Y = Cells(2, 1).End(xlDown).Row To X + 1 Step -1
If Cells(X, 104).Interior.Color = RGB(255, 255, 0) _
And Cells(Y, 104).Interior.Color = RGB(255, 255, 0) Then
If Cells(X, 104) = Cells(Y, 104) Then
Rows(Y).Delete
End If
End If
Next Y
Next X
Application.ScreenUpdating = True
End Sub
Public Function 串聯_文字(A)
f = ""
For i = 1 To UBound(A)
If A(i) = "" Then A(i) = "-"
f = f & A(i)
Next i
串聯_文字 = f
End Function

複製代碼

作者: 軒云熊 時間: 2020-10-12 05:30

回復 18# wei9133

剛才發現跑太久了所以改了一下有比較好一點但是還是很慢

Public Sub 多列比對練習()
Application.ScreenUpdating = False
Dim Arr, i&, j&, t&, tj&, x&, y&, T1$, T2$, T3$, T4$
Arr = Range(Cells(Rows.Count, 1).End(xlUp), Cells(2, 100))
For t = 1 To UBound(Arr, 1)
TI = "": T2 = ""
For tj = 1 To UBound(Arr, 2)
If Arr(t, tj) = "" Then
Arr(t, tj) = "-"
Arr(t, tj) = Arr(t, tj) & Arr(t, tj)
End If
T1 = Arr(t, tj)
T2 = T2 & T1
If tj = UBound(Arr, 2) Then T2 = T2 & Cells(t + 1, 104)
Next tj
For i = UBound(Arr, 1) To t + 1 Step -1
T3 = "": T4 = ""
For j = 1 To UBound(Arr, 2)
If Arr(i, j) = "" Then
Arr(i, j) = "-"
Arr(i, j) = Arr(i, j) & Arr(i, j)
End If
T3 = Arr(i, j)
T4 = T4 & T3
If j = UBound(Arr, 2) Then T4 = T4 & Cells(i + 1, 104)
Next j
If T4 = T2 Then
Cells(t + 1, 101) = Cells(t + 1, 101) + Cells(t + 1, 101)
Cells(i + 1, 101) = Cells(i + 1, 101) + Cells(i + 1, 101)
Cells(t + 1, 103) = Cells(t + 1, 103) - Cells(t + 1, 103)
Cells(i + 1, 103) = Cells(i + 1, 103) - Cells(i + 1, 103)
Cells(t + 1, 104).Interior.Color = RGB(255, 255, 0)
Cells(i + 1, 104).Interior.Color = RGB(255, 255, 0)
End If
Next i
Next t
For x = 2 To Cells(2, 1).End(xlDown).Row
For y = Cells(2, 1).End(xlDown).Row To x + 1 Step -1
If Cells(x, 104).Interior.Color = RGB(255, 255, 0) _
And Cells(y, 104).Interior.Color = RGB(255, 255, 0) Then
If Cells(x, 104) = Cells(y, 104) Then
Rows(y).Delete
End If
End If
Next y
Next x
Application.ScreenUpdating = True
End Sub

複製代碼

作者: wei9133 時間: 2020-10-15 06:54

本帖最後由 wei9133 於 2020-10-15 06:56 編輯

回復 22# 軒云熊

你好，因為後面這個已經變成比對了，所以跟一開始的作法已經不一樣
然後這兩天又增加新英雄，所以格子又不一樣了..

而比對的部分因為後面還加上整合成一行的部分
那就又必須考慮到幾個條件
1.A~CX(敗勝雙方出陣) & DB(星象)長的一模一樣的列
2.有些比較常出現的組合會有暫存的篩選快捷，裡面也有值的
  具體是CZ(備註)DC跟DE有雙方出陣的簡寫方便篩選後快速辨識
  (看不懂的話執行 "Sub 暫存篩選()"快捷鍵 ctrl+L，會比較好理解)
  或著這樣講判斷上面這三個其中一個有值的，合併的基本就是它，把其他的勝敗場都加到這一列上面

3.所以是把符合"條件一"的列去比對，全部加在符合"條件二"的列上面，然後把該列的勝敗場都加起來填在各自的勝敗場
  要被合併的勝場該欄位數字要加1，因為出現這一列本身就是勝了一場，多勝一場才會在在勝場數上加上數字
  而敗場則否
  譬如
  共有三列符合上述所有條件 A~CX相同、DB相同
  而勝場部份的值則分別為3、空格、1，敗場的值則為1、空格、空格
  算出來合併的勝場欄位應為"6"，敗場則為"1"
  算法是這樣的，假設3那格保留，而空格代表勝1場，勝場填入1的實際上是"當列"加"勝1場"
  所以加出來是"6"

https://mega.nz/file/7dQmCLjI#QCQsI9fga6rZlsXJYLfrfaGz2ZUVmFLaCXtTOLFNvqI
我直接附上檔案，你用此檔案測試即可，有原始檔案也有助於你理解我說的到底是甚麼
當然如果有更好的方法也請提出
至於如果有幸有寫出vba程式碼的話
煩請直接回覆於帖子之中
(因為後續還會有新英雄加入，所以麻煩幫我註解若格子往後推的話要改哪個地方)

上面檔案中已有巨集，如有疑慮可以不開啟
巨集功用分別為Module2 塗底色(格式化條件)
Module1 篩選(V|W|空格|非空格|取消篩選)/字型顏色加粗

P.S.要注意版本用的是EXCEL 2003，我不清楚VBA的版本是否通用。

作者: jcchiang 時間: 2020-10-16 08:39

回復 23# wei9133

1.mega的檔案因公司限制無法下載,所以使用前面的檔案內容寫
2.A~CV+星象相同的列統計其勝場&敗局(使用檔案內欄位的值累計)
3.保留的列勝場多加1
4.勝場為空白的填入1,視勝場為1
5.程式無執行刪除列的動作,將資料列在[a400]位置
以上是我能理解的部份

Sub ex3()
Dim d As Object, ar As Object, r As Object
Dim i%, AA$, a

Set d = CreateObject("Scripting.Dictionary")
Set ar = [A1].CurrentRegion

For i = 1 To ar.Rows.Count
AA = Join(Application.Transpose(Application.Transpose(ar(i, 1).Resize(, 100))), ",") & "," & ar(i, 104) '建立判斷條件
If ar(i, 101) = "" Then ar(i, 101) = 1 '勝場空白填入1
If Not d.exists(AA) Then '字典內查無該條件
   d(AA) = ar(i, 1).Resize(, 104) '增加字典資料
Else
   a = Application.Transpose(Application.Transpose(d(AA))) '將字典資料取出
   a(101) = a(101) + ar(i, 101) '勝率累加
   a(102) = a(102) + 1          '備註:相符的筆數(不包含第一筆)
   a(103) = a(103) + ar(i, 103) '敗局累加
   d(AA) = a '將資料放回字典
End If
Next
[a400].Resize(d.Count, 104) = Application.Transpose(Application.Transpose(d.items)) '將字典資料列出
For Each r In Range([cw401], [cw401].End(4))  '保留勝場+1
r.Value = r.Value + 1
Next
Set d = Nothing
End Sub

作者: 軒云熊 時間: 2020-10-16 19:23

本帖最後由軒云熊於 2020-10-16 19:26 編輯

回復 23# wei9133

檔案無法開啟看要不要再上傳一次不用全部有部分可以測試就可以了
你先看看 jcchiang前輩寫的是不是你要的邏輯因為jcchiang前輩的寫法速度會快很多

javascript:;

作者: wei9133 時間: 2020-10-18 02:15

回復 24# jcchiang

回復 24# jcchiang

兩位好
首先先感謝二位花時間幫我想辦法

至於空間的部分
我重新換個空間
googl
https://drive.google.com/file/d/1VFZMILovCRpQT6AGyaAd8ZNb9VAZSFlO/view?usp=sharing
onedrive
https://1drv.ms/u/s!Amaq2OY73W7WiSHXDt88TA7rsUgC?e=BmwuJh

附件:我有砍東西因為論壇只給1MB，不過用來理解需求應該夠
[attach]32632[/attach]

Sub ex3()
Dim d As Object, ar As Object, r As Object
Dim i%, AA$, a
Set d = CreateObject("Scripting.Dictionary")
Set ar = [A1].CurrentRegion
For i = 1 To ar.Rows.Count
AA = Join(Application.Transpose(Application.Transpose(ar(i, 1).Resize(, 102))), ",") & "," & ar(i, 106) '建立判斷條件
If ar(i, 103) = "" Then ar(i, 103) = 1 '勝場空白填入1
If Not d.exists(AA) Then '字典內查無該條件
d(AA) = ar(i, 1).Resize(, 106) '增加字典資料
Else
a = Application.Transpose(Application.Transpose(d(AA))) '將字典資料取出
a(103) = a(103) + ar(i, 103) '勝率累加
a(104) = a(104) + 1 '備註:相符的筆數(不包含第一筆)
a(105) = a(105) + ar(i, 105) '敗局累加
d(AA) = a '將資料放回字典
End If
Next
[a14000].Resize(d.Count, 106) = Application.Transpose(Application.Transpose(d.items)) '將字典資料列出
For Each r In Range([cw14001], [cw14001].End(4)) '保留勝場+1
r.Value = r.Value + 1
Next
Set d = Nothing
End Sub

複製代碼

因為加了新英雄所以位置不一樣了
我把程式的數字都往後推，但是看起來是有問題的
應該是因為前面的沒有給圖所以這裡會有問題
(勝跟敗中間有一個備註欄位)
[attach]32622[/attach]
[attach]32624[/attach]
[attach]32623[/attach]

加總後應該優先填在這種列上 DC OR DE OR DK有值其次是CZ有值

P.S.
在把數值加上去之前有讓程式跑過一遍
不過跟預計的一樣，格子不對所以是有問題的
但發現有幾個想問問可否變更的部分
其一
目前資料已有九千多行，所以其實比對出來資料是否正確我也無法驗證
所以可否將運行完成後的直接產生另一個活頁簿，我直接看兩個活業簿的列數是否有差異
(當然初始驗證運作的時候可以先把固定的資料複製多行再到產生的活頁簿去看相同列是否有加總上去就知道了)
ex.
原始資料(sheet1)9000行，產生的新活頁簿(sheet2)(比對過的資料)，變成8800，這樣就可以知道確實有疊上去了
再人工去確認sheet1跟sheet2的差異點就可以確認程式是否正確

其二
執行的時候是否可加上
Application.Calculation = xlCalculationManual '關閉自動計算
Application.ScreenUpdating = False '關閉螢幕刷新
全部結束後再加上
Application.Calculation = xlCalculationAutomatic '開啟自動計算
Application.ScreenUpdating = True '開啟螢幕刷新
避免程式一直重新計算儲存格?
(我目前無法測，因為我也不知道目前的程式到底對不對)

to 軒云熊
抱歉之前我沒自己下回來測過，這次我有下回來測過了，應該可以用了
p.s. 無法解壓也有可能是因為rar版本過舊，可以試看看新版的rar，目前個人版是免費的。

真的沒法下載的話，我把第一列都拍下來了
[attach]32628[/attach]
[attach]32629[/attach]
[attach]32630[/attach]

目前是比對A~CX and DB長一樣
把上述條件一樣的列的CY(勝場) | DA(敗場) 加總填入同一列
至於填入哪一列優先考慮 DC OR DE OR DK有值其次是CZ有值
[attach]32631[/attach]
jcchiang所理解的條件是對的

作者: 軒云熊 時間: 2020-10-19 00:22

回復 26# wei9133

有空看一下不知道是不是你要的

javascript:;

作者: jcchiang 時間: 2020-10-19 10:23

回復 26# wei9133

資料改放置於第二個Sheet
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("對戰統計").[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

作者: wei9133 時間: 2020-10-20 22:59

回復 28# jcchiang

你好
先以5格為基準直接執行
經測試，勝率部分不管有沒有重複都會直接+1上去
圖一[attach]32636[/attach]
(原始資料)
圖二[attach]32637[/attach]
(產出資料)

勝率這格有問題的樣子
我總共以5格做測試，1~5格複製一份放在下面列中，僅更改星象部分
出來結果是錯誤的
圖三[attach]32638[/attach]
(原始資料)
圖四[attach]32639[/attach]
(產出資料)

正確應該為
圖5[attach]32640[/attach]

另外，之前要修正後資料放進sheet2內本來就是為了比對程式是否執行正確
這次也是多虧了這點才能看出加總的部分不對
而我的第二位置活頁簿其實是有其他資料的，這樣就直接把資料全蓋過去了
可以麻煩改成複製一份當前(sheet)執行程式的副本，然後直接在執行活頁簿中將重複列刪除加總?
(建立副本作為備份，直接在需要運行的活頁簿內做刪除，若無法
我想到的是執行後把目前的sheet1刪除，sheet2改名成sheet1而已)

複製副本的指令可以的話幫我加註解，確認程式都正常運行之後就不需要做副本了
因為副本本來就是為了驗證是否正確執行而存在的
感謝

作者: wei9133 時間: 2020-10-20 23:19

回復 27# 軒云熊
你好
直接執行你的附件，勝率的確會增加
以刪除下面幾行，僅複製2~3行做副本，貼在5~6行
執行不會運作(懷疑是因為我空行了)
圖1[attach]32641[/attach]

並且在你初始的檔案中，執行後並未合併，而是直接加上勝率(場)

圖2[attach]32642[/attach]
初始

圖3[attach]32643[/attach]
執行後

正確應該是
圖4[attach]32644[/attach]

作者: jcchiang 時間: 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
如要改放於其他位置或做法,程式中都有註解,請自行微調,謝謝!!

作者: 軒云熊 時間: 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

作者: wei9133 時間: 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
[attach]32649[/attach]
圖一的第一跟第二列勝率欄位都是0，代表各自當列的勝場，而這兩個結構都一樣
所以運行出來應該是
合併起來，勝率寫1 (實際上是贏2場沒錯，但自己這一列就代表了一場，所以勝率那格只會寫1)
第三行是獨自自己一個，沒有相同列，所以就只有保留，至於勝率因為該格是0，且只有它自己，所以應該留空
我想執行出來的結果
圖2
[attach]32650[/attach]
===============================================
實際執行出來的結果
圖3
[attach]32651[/attach]
我執行的結果出來感覺是，勝率那格無論是空還是1都會被視為1
但實際上應該是該列等於1，勝率那格若有數字，
且該列要被併到另一列的話，就要以該格數字加上自己這一列代表的1

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

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

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

作者: wei9133 時間: 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的部分還是沒用的
勝率那格有值的正確了，空的就會有問題，反之亦然
所以你改的這樣還是不太對
感謝你了

作者: jcchiang 時間: 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場勝場,其餘勝率欄有值的直接累加值

作者: jcchiang 時間: 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

作者: 准提部林 時間: 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

這勝敗率如何計算???

作者: 軒云熊 時間: 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 前輩跟准提大大所說的這樣複雜的組合算法?
或著能否簡單明瞭就好我實在不太明白抱歉...小弟數學不好

作者: 軒云熊 時間: 2020-10-25 01:20

回復 34# wei9133

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

javascript:;

作者: 軒云熊 時間: 2020-10-25 10:40

本帖最後由軒云熊於 2020-10-25 10:49 編輯

回復 34# wei9133

感覺敗局怪怪的所以改了一下有空幫我看一下感謝跑的速度慢了一些不知如何加快速度.....

Public Sub 練習1025()
Application.ScreenUpdating = False
Sheets(1).Select
Sheets(2).[a1].CurrentRegion.Clear
Dim Arr, D, xD, xD1, x&, y&, k&, T1$, T2$, T3$, T4$
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = 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
xD1(T1) = xD1(T1) + 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
Arr(x, 103) = xD(D)
Arr(x, 105) = xD1(D)
End If
End If
Next x
Next D
T2 = "": T4 = "": D = "": k = 1
For x = 2 To UBound(Arr, 1)
If Arr(x, 103) <> "" Or Arr(x, 105) <> "" Then
If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
k = k + 1
End If
For y = 1 To UBound(Arr, 2)
If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
Arr(k, y) = Arr(x, y)
End If
Next y
End If
Next x
Set xD = Nothing
Set xD1 = Nothing
Sheets(2).Range("A1").Resize(k, UBound(Arr, 2)) = ""
Sheets(2).Range("A1").Resize(k, UBound(Arr, 2)) = Arr
Erase Arr
Sheets(2).Select
Application.ScreenUpdating = True
End Sub

複製代碼

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

作者: wei9133 時間: 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可以出

所以目前只能這樣登記而已

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

作者: wei9133 時間: 2020-10-28 13:04

回復 wei9133

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

你好，這個執行會發生錯誤
[attach]32658[/attach]
[attach]32659[/attach]

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

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

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

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

作者: jcchiang 時間: 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

作者: 軒云熊 時間: 2020-10-30 01:10

回復 43# wei9133

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

作者: 軒云熊 時間: 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

複製代碼

作者: 軒云熊 時間: 2020-10-30 10:09

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

javascript:;

作者: 准提部林 時間: 2020-10-30 10:41

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

作者: 軒云熊 時間: 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

複製代碼

作者: 准提部林 時間: 2020-10-31 09:19

回復 50# 軒云熊

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

作者: 軒云熊 時間: 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)), "###%")

作者: wei9133 時間: 2020-10-31 23:59

回復 49# 准提部林

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

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

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

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

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

作者: wei9133 時間: 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我晚一點找時間測試
感謝

作者: wei9133 時間: 2020-11-2 02:53

回復 50# 軒云熊

你好#50的巨集，無法正常執行
[attach]32667[/attach]
[attach]32668[/attach]

作者: 軒云熊 時間: 2020-11-2 20:36

本帖最後由軒云熊於 2020-11-2 20:39 編輯

回復 55# wei9133

你有新增工作表嗎? 用這個試試看
我有把 jcchiang前輩的也放進去了 Sub ex5() 結果不太一樣
再看看我哪裡有問題在告訴我感謝

javascript:;

作者: wei9133 時間: 2020-11-6 22:02

回復 56# 軒云熊

你好，粗略直接測試你給的檔案，你可能沒有比對到106(星象)欄
直接將檔案載回，並將星象欄以數列下拉
讓其變成1~17，執行之後理論上來講，因為17個星象位置都不同所以至少應該要有17列
[attach]32670[/attach]
實際效果卻是
有兩個14，16、17消失，代表這個在這裡已經是有問題的了
[attach]32671[/attach]

作者: 軒云熊 時間: 2020-11-11 15:18

回復 57# wei9133
幫我看一下這結果可不可以感謝

javascript:;

作者: wei9133 時間: 2020-11-13 03:51

本帖最後由 wei9133 於 2020-11-13 03:52 編輯

回復 58# 軒云熊

你好，目前測試還有些問題，勝場加總部分對了
不過比對部分有些問題。
詳細請你看圖片

[attach]32680[/attach]
[attach]32681[/attach]
[attach]32682[/attach]
[attach]32683[/attach]
[attach]32684[/attach]
[attach]32685[/attach]
問題從這裡開始
[attach]32686[/attach]

[attach]32687[/attach]

如果論壇的圖不方便看的話
麻煩移駕相簿
(請從最後一張往前看)

作者: 軒云熊 時間: 2020-11-14 22:03

本帖最後由軒云熊於 2020-11-14 22:05 編輯

回復 59# wei9133

左右不用比對了嗎? 我把左右比對註解掉了有空你再試試看結果是否可以感謝

javascript:;

作者: 軒云熊 時間: 2020-11-14 22:22

回復 59# wei9133

如果左右不用比對那就直接比對星象再進行勝場跟敗場加總可以嗎?

作者: 軒云熊 時間: 2020-11-16 23:44

回復 59# wei9133

有空幫我試試看這個應該可以但是有一個很大的問題 ...如果資料很多會跑非常慢....

Public Sub 練習1116()
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
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)
xD(Arr(x, 106)) = xD(Arr(x, 106)) + 1
Next x
T1 = "": k = 2
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
T2 = T2 & T4 & Arr(x, 106)
T4 = ""
If D = T2 Then
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)
Next y
k = k + 1
Exit For
End If
End If
If D = Arr(x, 106) And xD(D) = 1 _
And Arr(x, 107) = "" And Arr(x, 109) = "" _
And Arr(x, 115) = "" And Arr(x, 104) = "" Then
For y = 1 To UBound(Arr, 2)
Arr(k, y) = Arr(x, y)
Next y
k = k + 1
Exit For
End If
Next x
If Arr(k - 1, 103) = 0 Then Arr(k - 1, 103) = ""
If Arr(k - 1, 105) = 0 Then Arr(k - 1, 105) = ""
Debug.Print k
Debug.Print D
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

複製代碼

作者: 軒云熊 時間: 2020-11-18 15:12

回復 59# wei9133

這會比較快一點但是還是很慢... 有空幫我試試看有沒有問題感謝

Public Sub 練習1118()
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$, T3$, E()
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
T1 = T1 & T3 & Arr(x, 106)
ReDim Preserve E(x)
E(x) = T1
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)
xD(Arr(x, 106)) = xD(Arr(x, 106)) + 1
Next x
T1 = "": k = 2
For Each D In xD
For x = 2 To UBound(Arr, 1)
If D = E(x) Then
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)
Next y
k = k + 1
Exit For
End If
End If
If D = E(x) And xD(D) = 1 _
And Arr(x, 107) = "" And Arr(x, 109) = "" _
And Arr(x, 115) = "" And Arr(x, 104) = "" Then
For y = 1 To UBound(Arr, 2)
Arr(k, y) = Arr(x, y)
Next y
k = k + 1
Exit For
End If
Next x
If Arr(k - 1, 103) = 0 Then Arr(k - 1, 103) = ""
If Arr(k - 1, 105) = 0 Then Arr(k - 1, 105) = ""
Next D
Set xD = Nothing: Erase E
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

複製代碼

作者: 軒云熊 時間: 2020-11-20 21:18

回復 59# wei9133

剛才試了一下發現 106星象有問題改了一下，有空再幫我試試看有沒有問題，感謝

javascript:;

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)