返回列表 上一主題 發帖

vba比對兩份資料是否一樣列出差異

回復 29# aassddff736


    另存檔情境多變化,建議手動另存
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 17# Andy2483


   
擷取.JPG
7 天前 14:55


請問大神
Sheet1名稱有碼數限制
我想另存差異表在開啟當案的地方或著預設路徑資料夾
如何修改

TOP

回復 32# aassddff736


    讓新工作表名不要違反此規則
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 30# Andy2483

謝謝指導! 真的很是感謝您幫忙解答
我有買書自習 但是還是小白

TOP

回復 13# Andy2483
哈嘍大神 可以幫我看看
為什麼 我比對資料只有一行時 差異資料沒秀出來
Excel比對原始資料.rar (54.49 KB)

TOP

回復 35# aassddff736

將 For j = 3 To C 改為 For j = 2 To C
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 10# Andy2483
      早安!大神
     我改這個 Sort KEY1:=.Item(1) 一樣"留下差異"沒資料
   
2024-02-19_102811.jpg
5 天前 10:32

TOP

回復 36# Andy2483


謝謝大神

不好意思看錯 回復
這個更改後For j = 2 To C 可以了

非常非常高興 謝謝大神的幫忙

TOP

回復 38# aassddff736

謝謝論壇,謝謝前輩上論壇一起學習
後學複習了一下並作註解,貼上來請前輩參考,請各位前輩指教

Option Explicit
Private Sub CommandButton1_Click()
Dim Arr, Brr, Crr, C%, Z, N&, i&, j%, R&, Ta$, Tb$, xR As Range, xB As Range, xS As Worksheet
'↑宣告變數,%是短整數,&是長整數,$是字串變數,As Range是儲存格變數,As Worksheet是工作表變數,其它沒有指定的是通用型變數
Set Z = CreateObject("Scripting.Dictionary"): Set xS = Sheets("比對結果")
'↑令Z變數是字典,令xS變數是工作表("比對結果")
Set Arr = Sheets("資料A").[A1].CurrentRegion: Arr = Union(Arr, Arr.Offset(, 1))
'↑令Arr變數是工作表("資料A").[A1]儲存格相鄰串聯後擴展成的最小方正區域儲存格
'令Arr變數變身為二維陣列 (聯集自身區域往右偏移1欄後的區域儲存格值帶入陣列中)

Set Brr = Sheets("資料B").[A1].CurrentRegion: Brr = Union(Brr, Brr.Offset(, 1))
'↑令Brr變數是工作表("資料A").[A1]儲存格相鄰串聯後擴展成的最小方正區域儲存格
'令Brr變數變身為二維陣列 (聯集自身區域往右偏移1欄後的區域儲存格值帶入陣列中)

C = UBound(Arr, 2): If C <> UBound(Brr, 2) Then [B6:B8] = "": [B9] = 0: [B10] = 0: MsgBox "欄數不同": Exit Sub
'↑令C變數是Arr陣列最大索引欄號
'如果C變數不同於Brr陣列最大索引欄號!就令[B6:B8]儲存格值是 空字元:令[B9]是0,令[B10]是0,最後跳出提視窗~~~,結束程式執行

ReDim Crr(1 To (UBound(Arr) + UBound(Brr)), 1 To C * 2 + 1)
'↑宣告Crr變數是二維陣列,縱向範圍從1 到(Arr陣列縱向最大索引列號+Brr陣列縱向最大索引列號),橫向範圍從1 到(C變數*2+1)
For i = 1 To UBound(Arr)
'↑設順迴圈!i從1 到Arr陣列縱向最大索引列號
   Ta = Trim(Arr(i, 1)): R = R + 1: Z(Ta) = R: Crr(R, 1) = Ta
   '↑令Ta這字串變數是 i迴圈列1欄Arr陣列值去除頭尾空白字元後的新字串,令R變數累加1
   '令以Ta變數為key,R變數為item納入Z字典中:令R變數列1欄Crr陣列值是 Ta變數

   For j = 1 To C: Crr(R, j + 1) = Arr(i, j): Next
   '↑設順迴圈!j從1 到變數C: 令R變數列(j+1)欄Crr陣列值是 i迴圈列j迴圈欄Arr陣列值
Next
For i = 1 To UBound(Brr)
'↑設順迴圈!i從1 到Brr陣列縱向最大索引列號
   Tb = Trim(Brr(i, 1)): N = Z(Tb): If N = 0 Then R = R + 1: Crr(R, 1) = Tb: N = R: Z(Tb) = R
   '↑令Tb這字串變數是 i迴圈列1欄Brr陣列值去除頭尾空白字元後的新字串,令N這長整數變數是以Tb變數為key查Z字典回傳值(item)
   '如果N變數是 0,就令R變數累加1:令R變數列1欄Crr陣列值是 Tb變數,令N變數=R變數,令以Tb變數為key,R變數為item納入Z字典中
   For j = 1 To C: Crr(N, j + 1 + C) = Brr(i, j): Next
   '↑設順迴圈!j從1 到變數C: 令N變數列(j+1+C)欄Crr陣列值是 i迴圈列j迴圈欄Brr陣列值
Next
Application.Goto xS.[A1]
'↑令游標跳到xS變數的[A1]儲存格位置
xS.UsedRange.EntireRow.Delete: xS.[A1] = "NUMBER"
'↑令xS變數裡有使用儲存格所在的列刪除,令xS變數的[A1]儲存格值是字串 "NUMBER"
With xS.[A2].Resize(R, C * 2 + 1): .Value = Crr: .Sort KEY1:=.Item(1), Order1:=1, Header:=2: Crr = .Value: End With
'↑令xS變數裡[A2]儲存格擴展剛好的區域以Crr陣列值帶入,並令以該區域儲存格以第1欄為基準做沒有標題列的順排序
xS.[B1] = [B2]: xS.[B1].Resize(, C - 1).Merge: xS.[B1].Interior.Color = [B2].Interior.Color
'↑令xS變數裡[B1]儲存格值同 本表[B2]儲存格值,令標題列儲存格合併,令該標題列儲存格底色同 本表[B2]儲存格底色
xS.[B1].Item(, C + 1) = [B3]: xS.[B1].Item(, C + 1).Resize(, C - 1).Merge: xS.[B1].Item(, C + 1).Interior.Color = [B3].Interior.Color
'↑令xS變數裡[B1]自身開始往右C+1欄儲存格值同 本表[B3]儲存格值
'令標題列儲存格合併,令該標題列儲存格底色同 本表[B3]儲存格底色

xS.UsedRange.EntireColumn.AutoFit: Set xR = xS.UsedRange: Set xR = xR(xR.Count + 1): Set xB = xR: xS.[1:1].HorizontalAlignment = xlCenter
'↑令xS變數裡有使用儲存格所在欄位自動調整欄寬,令xR變數是 xS變數裡有使用儲存格: 令xR變數是沒使用的地1個儲存格
'令xB變數是同xR變數(儲存格):令xS變數裡第1列儲存格格式 水平文字置中

For i = 2 To R + 1
'↑設順迴圈!i從2 到R變數+1
   For j = 2 To C
   '↑設順迴圈!j從2 到C變數
      Set xR = IIf(Crr(i - 1, j) <> Crr(i - 1, j + C), Union(xR, xS.Cells(i, j), xS.Cells(i, 1)), xR)
      '↑令兩區域相對欄位儲存格值如果不同!就將左區儲存格與A欄儲存格 納入xR變數中
      If Crr(i - 1, j) = "" Or Crr(i - 1, j + C) = "" Then Set xB = Union(xB, xS.Cells(i, j))
      '↑令兩區域相對欄位儲存格值如果是空格!就將左區儲存格 納入xB變數中
   Next
Next
Union(xR, xR.Offset(, C)).Font.ColorIndex = 3
'↑令兩區域比對出不同的儲存格 連同A欄儲存格xR變數字色變為紅色
xB.EntireRow.Font.ColorIndex = 5
'↑令xB變數所在列整列字色變為藍色
With Sheets("留下相同")
'↑以下是關於工作表("留下相同")的程序
   .UsedRange.EntireRow.Delete: xS.UsedRange.Copy .[A1]: .UsedRange.EntireColumn.AutoFit
   '↑令該表有使用儲存格所在的整列刪除: 令xS變數有使用儲存格複製到該表[A1]: 令該表有使用儲存格所在欄自動調整欄寬
   .Range(Intersect(xR.EntireRow, xS.UsedRange).Address).EntireRow.Delete
   '↑令有差異的列整列刪除
End With
With Sheets("留下差異")
'↑以下是關於工作表("留下差異")的程序
   .UsedRange.EntireRow.Delete: Intersect(Union(xS.[A1], xR.EntireRow), xS.UsedRange).EntireRow.Copy .[A1]: .UsedRange.EntireColumn.AutoFit
   '↑令該表有使用儲存格所在的整列刪除: 令xS變數有差異的列整列複製到該表[A1]: 令該表有使用儲存格所在欄自動調整欄寬
End With
[B6] = C - 1: [B7] = UBound(Arr): [B8] = UBound(Brr): [B9] = 1: [B10] = 1
'↑令本表[B6]值是 C變數-1: 令[B7]值是Arr陣列縱向最大索引列號: 令[B8]值是Brr陣列縱向最大索引列號
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

謝謝還這麼用心、詳細的註解,還有附加說明,感謝。
此讓學生學習了很多,更清楚的了解用法。

TOP

        靜思自在 : 虛空有盡.我願無窮,發願容易行願難。
返回列表 上一主題