EXCEL VBA Note

目錄

• 基本功能
  • 架構
  • 基本指令
    • sub
    • 為Module命名
    • Define variable: Dim & Set
    • 印出(crlt+G顯示及時運算視窗)
    • 跳視窗
    • Msgbox、inputbox等其他程式換行指令：vbCrLf
    • 輸入值
    • 輸入公式
    • 選出空白儲存格並填滿
    • 內建公式:sum
  • 顏色
    • 儲存格顏色填入1: RGB法
    • 常用顏色
    • 判斷式系列
    • 範例：調成數字，順便設個取消
    • 解除合併儲存格
    • 插入列
    • 指定本活頁簿
    • 切換至其他活頁簿
    • 工作表
    • 工作表總數
    • 工作表列總數
    • If以外的選擇：select case
    • 使警告視窗關閉，不會跳出警報
    • 開啟警告
    • 刪除列
    • offset:現有格子移動
    • 其他End()指令
    • copy & paste
    • 所有格線精簡版
    • 欄寬自動調整
    • 跳過error繼續執行
    • 樞紐分析表
    • 樞紐篩選的選取方式：PivotItem
  • 進階：表單
    • 顯示表單
    • 進度條概念
  • Sub 作品集
    • 關鍵字比對
    • 分割資料
    • 合併儲存格
    • 列出所有交叉篩選器
    • copy上一列
    • 列出所有資料夾
    • 資料reshape
    • 分割資料
    • 移動檔案
    • 比對兩張工作表

原文章來自 hackmd

查看排版(因為結束語法要End）

https://www.onlinegdb.com/online_vb_compiler

基本功能

架構

Project(專案)(通常為使用中的excel)
|
-->  模組  
     | 
     -->   Sub 

基本指令

sub

    Sub 基本指令()
     '在此輸入指令註解 
     在此輸入指令 
     end Sub

為Module命名

此code為txt檔可見

Attribute VB_Name = "Module2"

▼一般作法：在屬性中更改資料，如下紅標所示

Define variable: Dim & Set

Dim: 可在sub外執行，同一個Module下可共用變數，不指定type時為Varient

    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)

    Dim xDlg As FileDialog
     Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)

印出(crlt+G顯示及時運算視窗)

Debug.Print var1 & "," & var2; var3

跳視窗

建議參考微軟官方文件再依個人需求調整：https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/msgbox-function

    MsgBox var1

Msgbox、inputbox等其他程式換行指令：vbCrLf

    MsgBox r1.Row & "," & r1.Column & vbCrLf & r2.Row & "," & r2.Column

輸入值

    start_col = InputBox("起始欄在？", "起始欄", "A") '出來是字串

輸入公式

範例指向欄位的方式為絕對路徑，另有相對路徑，參考錄製巨集結果。

    Range("B1").FormulaR1C1 = "=COUNT(R3C3:R150C3)-1"

選出空白儲存格並填滿

Selection.SpecialCells(xlCellTypeBlanks).Select

    Range("A4:Z4").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"

內建公式:sum

dim s
s = WorksheetFunction.Sum(Range("F2:F10"))

顏色

儲存格顏色填入1: RGB法

With Cells(1, 1) '在A1下
            .Value = "RGB(" & 170 & "," & 225 & "," & 10 & ")"
            .Interior.color = RGB(170, 225, 10)
End With

image

常用顏色

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) '土黃

image

判斷式系列

範例：調成數字，順便設個取消

用IsNumeric()搭配if進行判斷，注意If式若有換行，需有End If做結束

    If IsNumeric(start_col) = False Then
    start_col = Range(start_col & 1).Column
    ElseIf srart_col = "" Then End
    End If

解除合併儲存格

    Selection.UnMerge

插入列

    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

指定本活頁簿

    ThisWorkbook.Activate

ThisWorkbook下其他物件，適合變成變數

    ThisWorkbook.Name
    ThisWorkbook.Path 

皆可搭配”.副檔名”做存檔

切換至其他活頁簿

     Windows("活頁簿1.xlsx").Activate

工作表

選取工作表

1. 以工作表名選取

    Sheets("工作表1").Select

2. 以工作表位置選取

    Sheets(1).Select

當前工作表

    ActiveSheet.Select
    ActiveSheet.Name

新增新活頁簿

     Workbooks.Add

工作表總數

    Worksheets.Count 

工作表列總數

    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的用法：

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: 指定儲存格之行

    Col = Range("A1").End(xlToRight).Column

其他End()指令

有UP、Down、Left、Rigt等，相當於Crlt+方向鍵

    Range("A1").End(xlToLeft).Select

    Range("A1").End(xlToUp).Select

copy & paste

copy

    Range("I4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("B2").Select

貼上值

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

純貼上

    Range("B2").Select
    ActiveSheet.Paste

所有格線精簡版

    Range("A2:D29").Select
    Selection.Borders.LineStyle = xlContinuous

欄寬自動調整

Range("E3:I3").Columns.AutoFit

跳過error繼續執行

迴圈裡會跳過執行迴圈

On Error Resume Next

樞紐分析表

soucedata若為外部連結格式為：[主檔案名]工作表名!R(列數編號)C(行數編號):R(列數編號)C(行數編號)

 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

範例：勾選所有年度

    Dim PivotItem As PivotItem
    For Each PivotItem In ActiveSheet.PivotTables("樞紐分析表1").PivotFields("年度").PivotItems
        PivotItem.Visible = True
    Next PivotItem

進階：表單

顯示表單

用sub呼叫

# 表單變數名稱+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，程式大概長這樣

Userform1.Lebel2.Caption =%數*100 & "%已完成"
Userform1.Frame1.width = %數*初始設定長度
doevents

Sub 作品集

關鍵字比對

1. 方法1: 製作VBScript.Reg物件
2. 方法2: 以instr()+Array迴圈尋找

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

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

分割資料

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欄為對象

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有使用交叉篩選器，需定位時可使用
原來源：https://www.excelcampus.com/vba/vba-macro-list-all-slicers/

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

    Sub copy上一列()
    
    Rows("100:100").Select
    Application.CutCopyMode = False
    Selection.FillDown
    
    End Sub

列出所有資料夾

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

寫在工作表的版本：

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

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

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

分割資料

以等筆數切割資料為數份，並標上欄位名稱

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.原理

可搭配列出資料夾下所有檔案使用

Sub MoveFile()
 Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")

    FSO.MoveFile "C:\Users\Path\d1.docx", _
    "C:\Users\Path2\p3\d1.docx"
End Sub

比對兩張工作表

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