# **EXCEL VBA**
<i class="fa fa-book fa-fw"></i>
查看排版(因為結束語法要End）
---
https://www.onlinegdb.com/online_vb_compiler
基本功能
---
## 架構
Project(專案)**(通常為使用中的excel)** <br>
| <br>
--> 模組 <br>
  | <br>
 --> Sub <br>
## 基本指令
### sub
``` Visual Basic for Applications=
Sub 基本指令()
'在此輸入指令註解
在此輸入指令
end Sub
```
### 為Module命名
> 此code為txt檔可見 <br>
``` Visual Basic for Applications=
Attribute VB_Name = "Module2"
```
▼一般作法：在屬性中更改資料，如下紅標所示<br>
### Define variable: Dim & Set
> Dim: 可在sub外執行，同一個Module下可共用變數，**不指定type時為Varient** <br>
``` Visual Basic for Applications=
Dim var1 As Integer
var1 = 1
Dim var2 As String
var2 = "my name is var2"
Dim var3 As Double
var3 = 2.34567
```
> Set: 定義物件時使用，需在Sub內執行，**變數仍需定義(不知道型態時可定義為Varient)**
``` Visual Basic for Applications=
Dim xDlg As FileDialog
Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
```
### 印出(crlt+G顯示及時運算視窗)
``` Visual Basic for Applications=
Debug.Print var1 & "," & var2; var3
```
### 跳視窗
>建議參考微軟官方文件再依個人需求調整：https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/msgbox-function <br>
``` Visual Basic for Applications=
MsgBox var1
```
### Msgbox、inputbox等其他程式換行指令：vbCrLf
``` Visual Basic for Applications=
MsgBox r1.Row & "," & r1.Column & vbCrLf & r2.Row & "," & r2.Column
```
### 輸入值
``` Visual Basic for Applications=
start_col = InputBox("起始欄在？", "起始欄", "A") '出來是字串
```
### 輸入公式
>範例指向欄位的方式為絕對路徑，另有相對路徑，參考錄製巨集結果。
``` Visual Basic for Applications=
Range("B1").FormulaR1C1 = "=COUNT(R3C3:R150C3)-1"
```
### 選出空白儲存格並填滿
>Selection.SpecialCells(xlCellTypeBlanks).Select
``` Visual Basic for Applications=
Range("A4:Z4").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
```
### 內建公式:sum
``` Visual Basic for Applications=
dim s
s = WorksheetFunction.Sum(Range("F2:F10"))
```
## 顏色
### 儲存格顏色填入1: RGB法
``` Visual Basic for Applications=
With Cells(1, 1) '在A1下
.Value = "RGB(" & 170 & "," & 225 & "," & 10 & ")"
.Interior.color = RGB(170, 225, 10)
End With
```
> 
### 常用顏色
```
RGB(170,225,10) '綠
RGB(225,5,60) '紅
RGB(225,75,10) '橘
RGB(115,225,14010) '淡藍
RGB(105,120,9300) '深藍
RGB(225,190,20240) '淡紫
RGB(225,225,10) '土黃
```
> 
### 判斷式系列
### 範例：調成數字，順便設個取消
> 用IsNumeric()搭配if進行判斷，注意If式若有換行，需有End If做結束
``` Visual Basic for Applications=
If IsNumeric(start_col) = False Then
start_col = Range(start_col & 1).Column
ElseIf srart_col = "" Then End
End If
```
### 解除合併儲存格
``` Visual Basic for Applications=
Selection.UnMerge
```
### 插入列
``` Visual Basic for Applications=
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
```
### 指定本活頁簿
``` Visual Basic for Applications=
ThisWorkbook.Activate
```
>ThisWorkbook下其他物件，適合變成變數
``` Visual Basic for Applications=
ThisWorkbook.Name
ThisWorkbook.Path
````
> <font color = Red>**皆可搭配"\檔名.副檔名"做存檔**</font>
### 切換至其他活頁簿
``` Visual Basic for Applications=
Windows("活頁簿1.xlsx").Activate
```
### 工作表
>選取工作表 <br>
1. 以工作表名選取 <br>
``` Visual Basic for Applications=
Sheets("工作表1").Select
```
2. 以工作表位置選取 <br>
``` Visual Basic for Applications=
Sheets(1).Select
```
>當前工作表
``` Visual Basic for Applications=
ActiveSheet.Select
ActiveSheet.Name
```
> 新增新活頁簿
``` Visual Basic for Applications=
Workbooks.Add
```
### 工作表總數
``` Visual Basic for Applications=
Worksheets.Count
```
### 工作表列總數
``` Visual Basic for Applications=
ActiveSheet.UsedRange.Rows.Count '該工作表列總數，反之行換成column
```
### If以外的選擇：select case
>在做依變量改變成幾種情況(字串或數字皆可)時可以使用，以下範例：
Select Case Sheets.Count
Case 5
MsgBox "不用刪喇"
Case 28
MsgBox "表數過多，要刪喔"
For i = 2 To Sheets.Count - 4
Sheets(2).Select
> 以string做辨別+Case Else的用法：
``` Visual Basic for Applications=
For i = 2 To Range("A2").End(xldown).row
Select Case Cells(i, 2).Value
Case 小明
MsgBox "叫小明的資料不用刪"
Case Else Cells(i, 2).Value
MsgBox "其他的資料須刪除"
'刪除工作表
ActiveWindow.SelectedSheets.Delete
Next '迴圈結尾
Application.DisplayAlerts = True
Case Else
End
End Select 'Select結尾
```
>▲只有sheet.count是5或28時才有執行程式，其他不會執行
### 使警告視窗關閉，不會跳出警報
> excel vba限定的樣子，其他office vba可以執行此指令，但沒有效果
Application.DisplayAlerts = False
### 開啟警告
Application.DisplayAlerts = True
### 刪除列
> 範例：第一列刪掉
Rows(1).EntireRow.Delete
#### 另存新檔
> 令存為xlsx
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\檔名.副檔名" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
#### 儲存格填值
> 1. 使用Range物件
Range("A1").Value = "A1的值"
> 2. 使用Cells物件
Range(1,1).Value = "A1的值"
### 選取儲存格
Range("A1").Select
### offset:現有格子移動
>Note: Selection = 現在選的儲存格
>往右一格
Selection.offset(0, 1).Select
>往下一格
Selection.offset(1, 0).Select
### 求筆數/行數，並存成變數
> Row: 指定儲存格之列
Row = Range("A1").End(xlDown).Row
>Column: 指定儲存格之行
``` Visual Basic for Applications=
Col = Range("A1").End(xlToRight).Column
```
### 其他End()指令
> 有UP、Down、Left、Rigt等，相當於Crlt+方向鍵
``` Visual Basic for Applications=
Range("A1").End(xlToLeft).Select
Range("A1").End(xlToUp).Select
```
### copy & paste
>**copy**
``` Visual Basic for Applications=
Range("I4").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("B2").Select
```
>**貼上值 **
``` Visual Basic for Applications=
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
```
>**純貼上**
``` Visual Basic for Applications=
Range("B2").Select
ActiveSheet.Paste
```
### 所有格線精簡版
Range("A2:D29").Select
Selection.Borders.LineStyle = xlContinuous
### 欄寬自動調整
``` Visual Basic for Applications=
Range("E3:I3").Columns.AutoFit
```
### 跳過error繼續執行
>迴圈裡會跳過執行迴圈
``` Visual Basic for Applications=
On Error Resume Next
```
### 樞紐分析表
>soucedata若為外部連結格式為：[主檔案名]工作表名!R(列數編號)C(行數編號):R(列數編號)C(行數編號)
``` Visual Basic for Applications= ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
ThisWorkbook.Path & "\" & 活頁簿 & 工作表 & "!R1C1:R" & Row & "C" & Col, Version:= _
xlPivotTableVersion15).CreatePivotTable TableDestination:=title(i) & "!R1C9", _
TableName:="樞紐分析表" & i, DefaultVersion:=xlPivotTableVersion15
```
### 樞紐篩選的選取方式：PivotItem
> 範例：勾選所有年度
``` Visual Basic for Applications=
Dim PivotItem As PivotItem
For Each PivotItem In ActiveSheet.PivotTables("樞紐分析表1").PivotFields("年度").PivotItems
PivotItem.Visible = True
Next PivotItem
```
## 進階：表單
### 顯示表單
>用sub呼叫
```Visual Basic for Applications=
# 表單變數名稱+show
Userform1.Show
```
### 進度條概念
1. 興建表單
2. 設置Lebel1, Lebel2,Frame1
3. Framr1顏色為藍色，放Lebel1裡面
4. 對表單右鍵>查看程式碼
5. 程式視窗上方有2個下拉式選單，分別選擇userform, initialize ，然後sub內設定Frame1出始長度為0、可視
6. 再選userform, activate，設定呼叫計算總進度的sub名稱
7. 模組內建立計算總進度的sub，計算總進度（通常看迴圈次數估）、累積進度、%值，將這兩個變數傳至主要作用的Sub裡
8. 主要作用的sub中每隔一段時間要計算累積進度跟%值，並回傳給另一個決定進度條長度的sub，程式大概長這樣
```Visual Basic for Applications=
Userform1.Lebel2.Caption =%數*100 & "%已完成"
Userform1.Frame1.width = %數*初始設定長度
doevents
```
## Sub 作品集
### 關鍵字比對
> 1. 方法1: 製作VBScript.Reg物件
> 2. 方法2: 以instr()+Array迴圈尋找
``` Visual Basic for Applications=
Sub 關鍵字比對()
Dim 關鍵字 As Object
Dim temp, Str As String
temp = ""
Set 關鍵字 = CreateObject("VBScript.RegExp")
Sheets("含有關鍵字的工作表").Select
'關鍵字起始列至結束列
For i = 2 To 1719
temp = temp & Range("A" & i) & "|"
Next i
temp = "(" & temp & Range("A" & ActiveSheet.UsedRange.Rows.Count).Value & ")"
'所有的關鍵字格式: "(A|B|C)" ，以此類推
Debug.Print temp
關鍵字.Pattern = temp
Sheets("欲對照檔案").Select
n = Range("a1").End(xlDown).Row
For k = 2 To n
'假設要測D欄
Str = Range("D" & k)
If 關鍵字.test(Str) Then
Debug.Print k & ":OK"
Else
Debug.Print k & ":" & Str
End If
Next k
End Sub
```
> 方法2
``` Visual Basic for Applications=
Sub sol2()
'另一種尋找關鍵字的方法，把要找的字串跟keyword都變成array會比較快
Dim key
key = Array("要找的關鍵字")
for i = 0 to 0
If InStr(1, Range("A1"), key, vbBinaryCompare) Then
Debug.Print "OK"
End If
next i
End sub
```
### 分割資料
``` Visual Basic for Applications=
Sub 分割資料()
Dim 副檔名, FilePath As String
Dim 原始檔 As Workbook
Dim xDlg As FileDialog
Dim filefont, start_col, end_col, diff
副檔名 = "XXX"
'設定副檔名，用陽春的if判定filefont要是甚麼屬性(後面會用到)
Do Until 副檔名 <> "XXX"
副檔名 = InputBox("檔案要分割成甚麼檔？要輸入副檔名喔喔喔" & vbCrLf _
& "目前可用：xlsx、csv、ods、xls", "求副檔名", "xlsx")
If 副檔名 = "csv" Or 副檔名 = ".csv" Then
filefont = xlCSV
ElseIf 副檔名 = "xlsx" Or 副檔名 = ".xlsx" Then
filefont = xlOpenXMLWorkbook
ElseIf 副檔名 = "ods" Or 副檔名 = ".ods" Then
filefont = xlOpenDocumentSpreadsheet
ElseIf 副檔名 = "xls" Or 副檔名 = ".xls" Then
filefont = xlExcel8
ElseIf 副檔名 = "" Then '唯一逃出迴圈手段:什麼都不做按取消
End
Else
MsgBox "這個程式很陽春，不支援這個副檔名><"
副檔名 = "XXX"
End If
Loop
'加點點
If Left(副檔名, 1) <> "." Then 副檔名 = "." & 副檔名
Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
xDlg.Title = "請選擇分割檔案放置的資料夾"
'選擇要輸出的資料夾，有選到就存成變數
If xDlg.Show <> -1 Then Exit Sub
FilePath = xDlg.SelectedItems(1) & "\"
ThisWorkbook.Activate
start_col = InputBox("起始欄在？", "起始欄", "A")
'調成數字，順便設個取消
If IsNumeric(start_col) = False Then
start_col = Range(start_col & 1).Column
ElseIf srart_col = "" Then End
End If
end_col = InputBox("最後一欄在？", "最後一欄", "B")
'調成數字，順便設個取消
If IsNumeric(end_col) = False Then
end_col = Range(end_col & 1).Column
ElseIf end_col = "" Then End
End If
'key幾筆資料
diff = InputBox("要幾筆資料為一個檔案？打數字喔", "幾筆", 2000)
'變integer(整數)格式
diff = CInt(diff)
For i = 2 To ActiveSheet.UsedRange.Rows.Count Step diff
ThisWorkbook.Activate
'選取位置
Range(Cells(i, start_col), Cells(i + diff - 1, end_col)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs filename:= _
FilePath & "第" & i & "列開頭" & 副檔名, FileFormat:=filefont, _
CreateBackup:=False
'插表頭在第一列
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'原檔開啟、複製表頭
ThisWorkbook.Activate
Cells(1, start_col).Select
Range(Cells(1, start_col), Cells(1, end_col)).Select
Selection.Copy
'切換當前檔案
Windows("第" & i & "列開頭" & 副檔名).Activate
Range("A1").Select
ActiveSheet.Paste
'存檔、關閉
ActiveWorkbook.Save
ActiveWindow.Close
Next
MsgBox "Done~ 去剛剛選的資料夾查看成果吧，檔名命名原則為「第X列開頭」"
End Sub
```
### 合併儲存格
> 以A欄B欄為對象
``` Visual Basic for Applications=
Sub 項次加合併()
'終點列都是C欄enddown
'標項次
Dim c
c = 1
ThisWorkbook.Activate
For i = 2 To Range("C2").End(xlDown).Row
If Range("B" & i) <> "" Then
Range("A" & i) = c
c = c + 1
End If
Next
'----
'第一項值合併
Dim n
'為了防止最後一列明明不用合併還合併，終點設倒數第二列
For i = 2 To Range("C2").End(xlDown).Row - 1
n = 1
If Range("B" & i) <> "" And Range("B" & i + 1) = "" Then
Do
Range("B" & i & ":B" & i + n).Select
n = n + 1
Debug.Print n
If i + n > Range("C2").End(xlDown).Row Then Exit Do
Loop Until Range("B" & i + n).Value <> ""
End If
Selection.Merge
Next
'------
'項次合併
'為了防止最後一列明明不用合併還合併，終點設倒數第二列
For i = 2 To Range("C2").End(xlDown).Row - 1
n = 1
If Range("A" & i) <> "" And Range("A" & i + 1) = "" Then
Do
Range("A" & i & ":A" & i + n).Select
n = n + 1
Debug.Print n
'需要強制結束迴圈
If i + n > Range("C2").End(xlDown).Row Then Exit Do
Loop Until Range("A" & i + n).Value <> ""
End If
Selection.Merge
Next
End Sub
```
### 列出所有交叉篩選器
> 若excel有使用交叉篩選器，需定位時可使用 <br>
>原來源：https://www.excelcampus.com/vba/vba-macro-list-all-slicers/
``` Visual Basic for Applications=
Sub 列出所有交叉篩選器()
'Description: List all slicers and sheet names in the Immediate window
'Author: Jon Acampora, Excel Campus
'Source: https://www.excelcampus.com/vba/vba-macro-list-all-slicers/
Dim sc As SlicerCache
Dim sl As Slicer
'SlicerCache.Name = 程式裡的交叉篩選器名稱
'Slicer.Parent.Name = 交叉篩選器所在表名
For Each sc In ActiveWorkbook.SlicerCaches
For Each sl In sc.Slicers
For Each si In sc.SlicerItems
If si.Selected = True Then
Debug.Print sl.Parent.Name & " | " & sl.Name & "|" & si.Name
End If
'sl.Caption = slicer header caption
'sl.Parent.Name = worksheet name
Next si
Next sl
Next sc
End Sub
```
### copy上一列
> 相當於整列選取後使用Crlt+D
``` Visual Basic for Applications=
Sub copy上一列()
Rows("100:100").Select
Application.CutCopyMode = False
Selection.FillDown
End Sub
```
### 列出所有資料夾
``` Visual Basic for Applications=
Sub 純print()
Dim folderPath As String
Dim filename, filetype, start_cell, end_col As String
Dim wb As Workbook
'
'1. 選取檔案所在的資料夾，作為路徑
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
'2. Optional: Properties
fDialog.Title = "請選擇資料夾"
'3. 如果有選完資料夾，便生成路徑變數
If fDialog.Show = -1 Then
folderPath = fDialog.SelectedItems(1) & "\"
End If
filename = Dir(folderPath & filetype)
Do While filename <> ""
Debug.Print filename
filename = Dir
Loop
End Sub
```
> 寫在工作表的版本：
``` Visual Basic for Applications=
Sub 寫在格子裡()
Dim folderPath As String
Dim filename, filetype, n, col
Dim wb As Workbook
'1. 選取檔案所在的資料夾，作為路徑
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
'2. Optional: Properties
fDialog.Title = "請選擇資料夾"
'3. 如果有選完資料夾，便生成路徑變數
If fDialog.Show = -1 Then
folderPath = fDialog.SelectedItems(1) & "\"
End If
filename = Dir(folderPath & filetype)
col = InputBox("請選擇放檔名的欄位", "欄位?", "A")
If IsEmpty(Range(col & 2)) = True Then n = 2 Else n = Range(col & 2).End(xlDown).Offset(1, 0).Row
Do While filename <> ""
Range(col & n).Value = filename
n = n + 1
filename = Dir
Loop
End Sub
```
### 資料reshape
``` Visual Basic for Applications=
Sub 一行變成矩陣()
'情境:資料全擠在A欄
Dim j, n, st
j = 0
n = Range("A1").End(xlDown).Row
st = CInt(InputBox("要隔幾筆資料一列?，結果顯示在D2", "隔幾筆", "5"))
Debug.Print n
'step: 從第1列到下一列開始貼的列隔多少
'i + (最後要選取的列 - 一開始選取的列)
For i = 1 To n Step st
Debug.Print i
Range(Cells(i, 1), Cells(i + st - 1, 1)).Select
Selection.Copy
Range("D" & i - (st - 1) * j + 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
j = j + 1
Next
End Sub
```
``` Visual Basic for Applications=
Sub 一列變成矩陣()
'情境:資料全擠在第一列
Dim j, n, st
j = 0
n = Range("A1").End(xlToRight).Column
st = CInt(InputBox("要隔幾筆資料一列?，結果顯示在A2", "隔幾筆", "5"))
For i = 1 To n Step st
Debug.Print 2 + i - (st - 1) * j
Range(Cells(1, i), Cells(1, i + st - 1)).Select
Selection.Copy
Range("A" & 2 + i - (st - 1) * j).Select
ActiveSheet.Paste
Debug.Print 2 + i - (st - 1) * j
j = j + 1
Next
End Sub
```
### 分割資料
> 以等筆數切割資料為數份，並標上欄位名稱
``` Visual Basic for Applications=
Sub 分割資料()
Dim 副檔名, FilePath As String
Dim 原始檔 As Workbook
Dim xDlg As FileDialog
Dim filefont, start_col, end_col, diff
副檔名 = "XXX"
'設定副檔名，用陽春的if判定filefont要是甚麼屬性(後面會用到)
Do Until 副檔名 <> "XXX"
副檔名 = InputBox("檔案要分割成甚麼檔？要輸入副檔名喔喔喔" & vbCrLf _
& "目前可用：xlsx、csv、ods、xls", "求副檔名", "xlsx")
If 副檔名 = "csv" Or 副檔名 = ".csv" Then
filefont = xlCSV
ElseIf 副檔名 = "xlsx" Or 副檔名 = ".xlsx" Then
filefont = xlOpenXMLWorkbook
ElseIf 副檔名 = "ods" Or 副檔名 = ".ods" Then
filefont = xlOpenDocumentSpreadsheet
ElseIf 副檔名 = "xls" Or 副檔名 = ".xls" Then
filefont = xlExcel8
ElseIf 副檔名 = "" Then '唯一逃出迴圈手段:什麼都不做按取消
End
Else
MsgBox "這個程式很陽春，不支援這個副檔名><"
副檔名 = "XXX"
End If
Loop
'加點點
If Left(副檔名, 1) <> "." Then 副檔名 = "." & 副檔名
Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
xDlg.Title = "請選擇分割檔案放置的資料夾"
'選擇要輸出的資料夾，有選到就存成變數
If xDlg.Show <> -1 Then Exit Sub
FilePath = xDlg.SelectedItems(1) & "\"
ThisWorkbook.Activate
start_col = InputBox("起始欄在？", "起始欄", "A")
'調成數字，順便設個取消
If IsNumeric(start_col) = False Then
start_col = Range(start_col & 1).Column
ElseIf srart_col = "" Then End
End If
end_col = InputBox("最後一欄在？", "最後一欄", "B")
'調成數字，順便設個取消
If IsNumeric(end_col) = False Then
end_col = Range(end_col & 1).Column
ElseIf end_col = "" Then End
End If
'key幾筆資料
diff = InputBox("要幾筆資料為一個檔案？打數字喔", "幾筆", 2000)
'變integer(整數)格式
diff = CInt(diff)
For i = 2 To ActiveSheet.UsedRange.Rows.Count Step diff
ThisWorkbook.Activate
'選取位置
Range(Cells(i, start_col), Cells(i + diff - 1, end_col)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs filename:= _
FilePath & "第" & i & "列開頭" & 副檔名, FileFormat:=filefont, _
CreateBackup:=False
'插表頭在第一列
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'原檔開啟、複製表頭
ThisWorkbook.Activate
Cells(1, start_col).Select
Range(Cells(1, start_col), Cells(1, end_col)).Select
Selection.Copy
'切換當前檔案
Windows("第" & i & "列開頭" & 副檔名).Activate
Range("A1").Select
ActiveSheet.Paste
'存檔、關閉
ActiveWorkbook.Save
ActiveWindow.Close
Next
MsgBox "Done~ 去剛剛選的資料夾查看成果吧，檔名命名原則為「第X列開頭」"
End Sub
```
### 移動檔案
>1.原理<br>
>可搭配列出資料夾下所有檔案使用
``` Visual Basic for Applications=
Sub MoveFile()
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.MoveFile "C:\Users\Path\d1.docx", _
"C:\Users\Path2\p3\d1.docx"
End Sub
```
### 比對兩張工作表
``` Visual Basic for Applications=
Sub 比對工作表()
'假設同一張工作下每列資料都不同
Dim sh1, sh2, sh1_r, sh1_c, sh2_r, sh2_c, str, record
'做為比較基準的工作表名稱
sh1 = "工作表1"
'欲比較的對象(修改要改它)
sh2 = "工作表1 (2)"
'總列數(可自定義)
sh1_r = Sheets(sh1).Range("A1").End(xlDown).Row
sh2_r = Sheets(sh2).Range("A1").End(xlDown).Row
'總行數(可自定義)
sh1_c = Sheets(sh1).Range("A1").End(xlToRight).Column
sh2_c = Sheets(sh1).Range("A1").End(xlToRight).Column
'製作字典
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For i = 2 To sh1_r
str = ""
For j = 1 To sh1_c
str = str & Cells(i, j).Value
Next j
dict.Add str, i
Next i
For i = 2 To sh2_r
str = ""
For j = 1 To sh2_c
str = str & Cells(i, j).Value
Next j
If dict.Exists(str) Then record = i & "、"
Next i
If Right(record, 1) = "、" Then record = Left(record, Len(record) - 1)
Debug.Print "第" & record & "列資料" & sh_1 & "沒有"
End Sub
```
Sign in with Wallet
Connect another wallet