jackson7015

回復 10# zheng211016
感謝zheng211016大大的協助

妳分割上下部分的用意是為了方便檢閱嗎?
是的，沒錯


且上下部分的資料都同一份?
資料會有些微不同，標題和欄數是相同的
因為下半部是從其他頁面複製過去比對的
所以要把不重複的都抓取出來
而兩個不重複的部分也要分開
所以分成上下部來檢視我覺得是最佳的方式

上跟下重複的資料丟在右側(重複定義:2個相同以上只留一個資料在右側)
重複的定義是完全不取出來
只留下不相同的資料比
就和資料移除重複的效果一樣
只是參考數據都要留著在左方，右側則是不重複的部分

那不重複的資料呢?需要丟到右側嗎?(不重複的資料:只有一筆獨一無二)
是的，不重複的部分都丟到右側
且，分為上下半部的不重複部分(檢閱用)

zheng211016

回復 11# jackson7015


你還是提供一個小小的範例好了
不用太多資料只要能夠詳細的顯示你要的結果就好

jackson7015

回復 12# zheng211016
呈現的的結果大概就是下面的檔案那樣
但是我是將資料先複製到工作頁面1
然後刪除不需要比對的部分
再用刪除重複的方式得出結果
再把資料回傳

不曉得表達的方式，能不能了解

    明細3.rar (999.75 KB)

下載次數: 5

2018-10-21 18:00

zheng211016

回復 13# jackson7015

我稍微懂一點你要的東西
只是還不是很清楚
但是大致上是不是就是
上半部資料 : 5~2676
下半部資料 : 2677~5562

上半部資料 跟 下半部資料 對照

上半部右側資料 :  與 左側下半部 不重複的資料
下半部右側資料 :  與 左側上半部 不重複的資料

然後下方檔案我是利用vba模擬你說的使用移除重複功能 你先看看
    明細3.rar (521.98 KB)

下載次數: 5

2018-10-21 20:52

jackson7015

回復 14# zheng211016
感謝zheng211016的幫忙

測試好幾次都怪怪的
發現原來是EXCEL的刪除重複方式會把重複的留一個下來
但是資料需求不需要留重複的項目

所以只要有重複的，都不需要複製到右側
而因為資料列因為還有其他不同的資料
所以列位會有不一樣(欄位都相同)

如果使用巨集可能還要做列位多寡判定
可能會比較麻煩

再請各位大大看看
感激不盡~

准提部林

１＞Ａ區／Ｂ區同時存在，剔除
２＞Ａ區有多筆相同，只取一筆（Ｂ區同理）
３＞右側結果每筆之間不留空白行，兩區各自上下區存放

寫得有點複雜，自行逐行參酌：
Xl0000283.rar (214.58 KB)

下載次數: 14

2018-10-23 20:10

Sub TEST()
Dim Arr, Brr, xD, i&, j%, U&, V&, N&, T1$, T2$, T3$
[O4:AA20000].Clear
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([M4], Cells(Rows.Count, 1).End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 13)
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1): T2 = Arr(i, 4): T3 = Arr(i, 8)
    If T1 = "座標" Then V = i - 1: GoTo 101
    If T1 = "" Or T2 = "" Or T3 = "" Then GoTo 101
    U = xD(T1 & T2 & T3)
    If U = 0 Then xD(T1 & T2 & T3) = i: GoTo 101
    If U > 0 And U <= V Then xD(T1 & T2 & T3) = -1
101: Next i

For i = 1 To UBound(Arr)
    T1 = Arr(i, 1): T2 = Arr(i, 4): T3 = Arr(i, 8)
    U = xD(T1 & T2 & T3)
    If T1 = "座標" And N > 0 Then N = V
    If T1 = "座標" Or U = i Then
       N = N + 1
       For j = 1 To 13: Brr(N, j) = Arr(i, j): Next
    End If
Next i

With [O4:AA4].Resize(UBound(Brr))
     .NumberFormatLocal = "@"
     .Value = Brr
     .Borders.LineStyle = 1
End With
End Sub

　

faye59

回復 9# jackson7015


    如10樓所言
不懂分割用意，
程序也可以寫成讓你方便檢視，
但你要把你的過程及結果詳細提出，
過程:執行的限制條件。
結果:執行後所想看的資訊。
要寫到巨集幾乎都是為了效率，
難以計算、重複動作太多、每日同樣操作繁瑣...等狀況，
我們就會以巨集簡易且快速計算。

建議手動先把你的範例結果上傳，
可能程式碼你不是很熟，
不知道程序能執行的效果到哪，
所以溝通上有所差異，
你講的問題我們都會在腦中先經過計算看是否可行或是否繁瑣，
覺得可以才會回覆你的問題。

faye59

回復 15# jackson7015


    抱歉，
沒看到後面還有第二頁，
大致上明白你要的結果了，
但准大已出馬，
小弟就不贅述了。

jackson7015

回復 16# 准提部林
回復 16# faye59
沒想到還讓大大出手協助
超級感謝 准提部林 版主大大的幫忙

程式運作沒問題，也能套用在其他分頁資料上
追加的２＞Ａ區有多筆相同，只取一筆（Ｂ區同理）也很好用
程式內容內部修改標題搜尋，就能運用在其他資料上了
程式碼定義和編成還要在了解一下

也感謝faye59的回覆

再次感謝協助過的大大們的幫忙

Andy2483

回復 16# 准提部林
        謝謝前輩!這太難了!
以下心得註解!請前輩再指導!
執行前:

下載 (334.8 KB)

2022-11-1 11:20

執行結果:

下載 (519.85 KB)

2022-11-1 11:21

Option Explicit
Sub TEST()
Dim Arr, Brr, xD, i&, j%, U&, V&, N&, T1$, T2$, T3$, S
S = Timer
'↑宣告變數
[O4:AA20000].Clear
'↑將儲存格清除
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典
Arr = Range([M4], Cells(Rows.Count, 1).End(xlUp))
'↑令Arr是字典!倒入:[M4]到A欄最後一有內容儲存格之間,
'擴展為最小方正區域儲存格的值
ReDim Brr(1 To UBound(Arr), 1 To 13)
'↑宣告Brr空陣列範圍縱向從1到Arr陣列縱向最大列數,
'橫向從1到13欄(兩個陣列大小相同)
For i = 2 To UBound(Arr)
'↑設順迴圈!從2 到Arr陣列縱向最大列數
    T1 = Arr(i, 1) '座標欄
    '↑令T1是Arr陣列迴圈列/第一欄值
   
    T2 = Arr(i, 4) '點數欄
    '↑令T2是Arr陣列迴圈列/第四欄值
   
    T3 = Arr(i, 8) '點數欄
    '↑令T3是Arr陣列迴圈列/第八欄值
   
    If T1 = "座標" Then
    '↑如果儲存格[M4] 裡的值是 "座標" 字串??
       V = i - 1  '@@
       '↑條件成立就令 V記憶是當下迴圈數 -1 ,這是要辨認A區最後列數
       GoTo 101
       '↑條件成立就跳到 101位置繼續執行
       ',B區標題列!此列不處理
    End If
    If T1 = "" Or T2 = "" Or T3 = "" Then
    '↑如果迴圈座標 迴圈點數 迴圈點數任何一個是空白
       GoTo 101
       '↑條件成立就跳到 101位置繼續執行,這是不處裡空白格
    End If
    U = xD(T1 & T2 & T3)
    '↑令U是 (迴圈座標,迴圈點數,迴圈點數)組合字串_以下稱(組合字串)為key的item值
    '初始值是 0
    If U = 0 Then
    '↑如果U 是初始值是 0,因為 U宣告長整數
       xD(T1 & T2 & T3) = i
       '↑條件成立!組合字串為key倒入xD字典!item值是迴圈數
       '這是Ａ區有多筆相同，只取一筆(B區同理)! 列數記憶在字典item裡
       GoTo 101
       '↑條件成立就跳到 101位置繼續執行
    End If
    If U > 0 And U <= V Then
    '↑如果U不是初始值!已經有迴圈數作為 item 了
    '而且U的列數小於等於(A區最後列數)!也就是在A區有且B區也有!
       xD(T1 & T2 & T3) = -1
       '↑條件成立!就令在xD字典裡以組合字串為key的item為 -1
       '這裡的 -1是不讓寫入Brr陣列裡
    End If
101: Next i

'1.A區/B區同時存在,剔除
'2.A區有多筆相同,只取一筆(B區同理)
'↑執行功能雖然是如此敘述!但後學在邏輯裡的心得是:
'1.1.全部迴圈判斷只有一筆的就留著!字典記憶所在列數!沒懸念!管他A區 或 B區
'1.2.全部迴圈判斷有多筆的!找到相同的第二筆看是不是在同區,在不同區這筆兩區都不要了

For i = 1 To UBound(Arr)
'↑設外順迴圈!從1 到Arr陣列縱向最大列數
    T1 = Arr(i, 1) '座標欄
    '↑令T1是Arr陣列迴圈列/第一欄值
   
    T2 = Arr(i, 4) '點數欄
    '↑令T2是Arr陣列迴圈列/第四欄值
   
    T3 = Arr(i, 8) '點數欄
    '↑令T3是Arr陣列迴圈列/第八欄值
    U = xD(T1 & T2 & T3)
    '↑令U是 (迴圈座標,迴圈點數,迴圈點數)組合字串_以下稱(組合字串)為key的item值
    '初始值是 0
    If T1 = "座標" And N > 0 Then
    '↑這 T1 = "座標" 是要辨認B區標題列數
    '↑如果迴圈跑到了 B區標題列數 而且N > 0 ,N宣告為長整數!初始值是 0
    ',所以一開始條件是不會成立的!這種邏輯寫法需要跳脫眼見為憑的觀念!
    '邏輯框架概念需要練習!無中生有的N 先知道要查宣告就可以了!
    '↑迴圈的一開始條件是不會成立的!
    '因為當i=1,T1 = "座標",N=0 , 當i=2,N=1,T1 已經不是字串 "座標"
   
       N = V
       '↑直到B區標題列開始條件成立!就令N=V!  V:在上方 @@標示處
       '這是要讓 資料要寫入結果陣列Brr的列數 切換到B區開始累加列數用的
    End If
    If T1 = "座標" Or U = i Then
    '↑如果迴圈座標欄是 "座標"字串(標題列也要寫進陣列Brr裡)
    '或 如果組合字串為key的item是迴圈數??
       N = N + 1
       '↑條件成立! N就累加 1,這是資料要寫入結果陣列Brr的列數
       For j = 1 To 13
       '↑設內順迴圈!從1 到 13(欄數)
          Brr(N, j) = Arr(i, j)
          '↑Arr陣列的值倒入Brr陣列 N對應的列位/j欄位裡
       Next
    End If
Next i
With [O4:AA4].Resize(UBound(Brr))
'↑關於[O4:AA4]向下匡列Brr陣列縱向最大列數的範圍儲存格,以下稱(匡列格)
     .NumberFormatLocal = "@"
     '↑匡列格的格式設為 文字
     .Value = Brr
     '↑值是Brr陣列裡對應的值
     .Borders.LineStyle = 1
     '↑儲存格格線設為 細實線
End With
MsgBox Timer - S & " 秒"
End Sub