kevinya

檢查工作表sheet是否存在:

Function sheetExists(wkb As Workbook, sheetToFind As String) As Boolean
    sheetExists = False
    For Each Sheet In wkb.Worksheets
        If sheetToFind = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet
End Function

使用dictionary: 包含  新增、刪除功能，無法直接修改        

'開啟RFQ檔案
Dim wkbRFQ As Workbook
Dim strRFQFileToOpen As String
Dim strRFQFilePath As String
strRFQFileToOpen = ""
'透過dialog視窗取得檔案名稱
strRFQFileToOpen = Application.GetOpenFilename _
(Title:="請選擇 RFQ檔案", _
FileFilter:="Excel Files *.xls* (*.xls*),")

If strRFQFileToOpen = "False" Then
    MsgBox "選取 RFQ檔案 失敗！.", vbExclamation, "Sorry!"
    Exit Sub
Else
    Set wkbRFQ = Workbooks.Open(strRFQFileToOpen)
End If

Dim wsRFQ As Worksheet

'優先抓AIT-New工作表，第二優先抓AIT_New工作表
If sheetExists(wkbRFQ, "AIT-New") = True Then
    Set wsRFQ = wkbRFQ.Sheets("AIT-New")
ElseIf sheetExists(wkbRFQ, "AIT_New") = True Then
    Set wsRFQ = wkbRFQ.Sheets("AIT_New")
Else
    MsgBox "錯誤！AIT-New 以及 AIT_New 工作表都不存在!", vbExclamation, "Success!"
    Exit Sub
End If

'combine 欄位資料
Dim FoundPart As Range
Set FoundPart = rows("1:1").Find("PART", LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)

'RFQ-
Dim FoundRFQDash As Range
Set FoundRFQDash = rows("1:1").Find("RFQ-", LookIn:=xlValues, LookAt:=xlWhole, _
    SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)

'序數-1
Dim FoundSerialDash1 As Range
Set FoundSerialDash1 = rows("1:1").Find("序數-1", LookIn:=xlValues, LookAt:=xlWhole, _
    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)    

Application.ScreenUpdating = False

Dim longLastRow As Long
longLastRow = wsRFQ.Cells(wsRFQ.rows.Count, FoundPart.Column).End(xlUp).Row

Dim dictRFQ                   'Create a variable
Set dictRFQ = CreateObject("Scripting.Dictionary")
dictRFQ.Add "aaa", 5
MsgBox "result1:" & dictRFQ.Item("aaa"), vbExclamation, "Success!"
dictRFQ.Remove ("aaa")
dictRFQ.Add "aaa", 6
MsgBox "result2:" & dictRFQ.Item("aaa"), vbExclamation, "Success!"

'然後做統計序數
Dim dictRFQ                   'Create a variable
Set dictRFQ = CreateObject("Scripting.Dictionary")
For i = 2 To longLastRow
    Dim tempKey As String
    tempKey = wsRFQ.Cells(i, FoundRFQDash.Column)
    If dictRFQ.Exists(tempKey) = True Then
        Dim tempCount As Integer
        tempCount = dictRFQ.Item(tempKey)
        tempCount = tempCount + 1
        dictRFQ.Remove (tempKey)
        dictRFQ.Add tempKey, tempCount
    Else
        dictRFQ.Add tempKey, 1
    End If
Next

'最後把統計結果回寫
For i = 2 To longLastRow
    Dim tmpKey As String
    tmpKey = wsRFQ.Cells(i, FoundRFQDash.Column)
    wsRFQ.Cells(i, FoundSerialDash1.Column) = dictRFQ.Item(tmpKey)
Next

新增多個欄位:        

'開啟RFQ檔案
Dim wkbRFQ As Workbook
Dim strRFQFileToOpen As String
Dim strRFQFilePath As String
strRFQFileToOpen = ""
'透過dialog視窗取得檔案名稱
strRFQFileToOpen = Application.GetOpenFilename _
(Title:="請選擇 RFQ檔案", _
FileFilter:="Excel Files *.xls* (*.xls*),")

If strRFQFileToOpen = "False" Then
    MsgBox "選取 RFQ檔案 失敗！.", vbExclamation, "Sorry!"
    Exit Sub
Else
    Set wkbRFQ = Workbooks.Open(strRFQFileToOpen)
End If

Dim wsRFQ As Worksheet

'優先抓AIT-New工作表，第二優先抓AIT_New工作表
If sheetExists(wkbRFQ, "AIT-New") = True Then
    Set wsRFQ = wkbRFQ.Sheets("AIT-New")
ElseIf sheetExists(wkbRFQ, "AIT_New") = True Then
    Set wsRFQ = wkbRFQ.Sheets("AIT_New")
Else
    MsgBox "錯誤！AIT-New 以及 AIT_New 工作表都不存在!", vbExclamation, "Success!"
    Exit Sub
End If

Application.ScreenUpdating = False
    
Dim lastColumn As Long
lastColumn = wsRFQ.Cells(1, wsRFQ.Columns.Count).End(xlToLeft).Column

'加欄位到最後
Dim InsertColumns As Variant
InsertColumns = Array("序數-1", "序數-終端客戶")
For i = LBound(InsertColumns) To UBound(InsertColumns)
    wsRFQ.Cells(1, lastColumn + i + 1) = InsertColumns(i)
Next

'加欄位到最前面
InsertColumns = Array("RFQ-", "RFQ-終端客戶")
lastColumn = wsRFQ.Cells(1, wsRFQ.Columns.Count).End(xlToLeft).Column
For i = LBound(InsertColumns) To UBound(InsertColumns)
    wsRFQ.Cells(1, lastColumn + i + 1) = InsertColumns(i)
Next
For ndx = UBound(InsertColumns) To 0 Step -1
    Dim Found As Range
    Set Found = rows("1:1").Find(InsertColumns(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
    SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    If Not Found Is Nothing Then
        Found.EntireColumn.Cut
        wsRFQ.Columns(1).Insert Shift:=xlToRight
        '清空記憶體裡面的內容，以免效能越來越差
        Application.CutCopyMode = False
    End If
Next ndx

參考資料:
excel - If WorkSheet("wsName") Exists - Stack Overflow
https://docs.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/dictionary-object