- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-5-5
|
39#
發表於 2024-2-21 09:04
| 只看該作者
回復 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 |
|
