[巨集VBA]初心者學習心得06:兩個excel快速比對key值並撈回單一欄位值,兩個excel快速比對key值並撈回多個欄位值,整列儲存格上色,設定整列的框線

  • 19
  • 0
  • 2021-06-07

兩個excel快速比對key值並撈回單一欄位值,兩個excel快速比對key值並撈回多個欄位值,整列儲存格上色,設定整列的框線

兩個excel快速比對key值並撈回單一欄位值:
wsPO, wsMOQ是兩個sheet物件,將會以key值做比對,一旦比對到資料,就會把wsMOQ的單一欄位的value複製回wsPO裡面

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

If strPOFileToOpen = "False" Then
    MsgBox "選取 PO 的檔案失敗!.", vbExclamation, "Sorry!"
    Exit Sub
Else
    Set wkbPO = Workbooks.Open(strPOFileToOpen)
    'MsgBox "開啟 PO 的檔案成功!.", vbExclamation, "成功!"
End If

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

If strMOQFileToOpen = "False" Then
    MsgBox "選取 MOQ 的檔案失敗!.", vbExclamation, "Sorry!"
    Exit Sub
Else
    Set wkbMOQ = Workbooks.Open(strMOQFileToOpen)
End If

Dim wsPO As Worksheet
Set wsPO = wkbPO.Worksheets(1)
If wsPO.FilterMode Then wsPO.ShowAllData
If wsPO.AutoFilterMode Then wsPO.AutoFilterMode = False

Dim wsMOQ As Worksheet
Set wsMOQ = wkbMOQ.Worksheets("MOQ")
If wsMOQ.FilterMode Then wsMOQ.ShowAllData
If wsMOQ.AutoFilterMode Then wsMOQ.AutoFilterMode = False

'找出Part#欄位
Dim FoundPartNumber As Range
Set FoundPartNumber = wsPO.Rows("1:1").Find("Part#", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

'找出各個excel的最後一列
Dim lastRowPO As Long
lastRowPO = wsPO.Cells(Rows.Count, FoundPartNumber.Column).End(xlUp).Row
Dim lastRowMOQ As Long
lastRowMOQ = wsMOQ.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastRowPO
                                    
    '到MOQ檔案要撈回來的值
    Dim MappingPOColumns1 As Variant
    MappingPOColumns1 = Array("MOQ", "Dock code", "Sales code")
    Dim MappingMOQColumns As Variant
    MappingMOQColumns = Array("Reel_qty", "Dock Code", "Sales Code")
    Dim SearchDirections1 As Variant '1:next, 2:previous
    SearchDirections1 = Array(1, 1, 1)
    Dim LookAts1 As Variant '1:xlWhole, 2:xlPart
    LookAts1 = Array(1, 2, 1)
    
    '到MOQ檔案要比對的key
    Dim MappingPOKeys As Variant
    MappingPOKeys = Array("Part#", "End Cust.", "MPS sales")
    Dim MappingMOQKeys As Variant
    MappingMOQKeys = Array("Device", "Sub customer", "Sales")
    Dim KeySearchDirections As Variant '1:next, 2:previous
    KeySearchDirections = Array(1, 1, 1)
    Dim KeyLookAts As Variant '1:xlWhole, 2:xlPart
    KeyLookAts = Array(2, 1, 1)
                                    
    For p = LBound(MappingPOColumns1) To UBound(MappingPOColumns1)
        Dim FoundPOKey As Range
        Set FoundPOKey = wsPO.Rows("1:1").Find(MappingPOKeys(p), LookIn:=xlValues, LookAt:=KeyLookAts(p), SearchOrder:=xlByColumns, _
        SearchDirection:=KeySearchDirections(p), MatchCase:=False)
        Dim FoundMOQKey As Range
        Set FoundMOQKey = wsMOQ.Rows("1:1").Find(MappingMOQKeys(p), LookIn:=xlValues, LookAt:=KeyLookAts(p), SearchOrder:=xlByColumns, _
        SearchDirection:=KeySearchDirections(p), MatchCase:=False)
        
        For q = 2 To lastRowMOQ
            If LCase(wsPO.Cells(i, FoundPOKey.Column)) = LCase(wsMOQ.Cells(q, FoundMOQKey.Column)) Then
                Dim FoundPOColumn1 As Range
                Set FoundPOColumn1 = wsPO.Rows("1:1").Find(MappingPOColumns1(p), LookIn:=xlValues, LookAt:=LookAts1(p), SearchOrder:=xlByColumns, _
                SearchDirection:=SearchDirections1(p), MatchCase:=False)
                Dim FoundMOQColumn As Range
                Set FoundMOQColumn = wsMOQ.Rows("1:1").Find(MappingMOQColumns(p), LookIn:=xlValues, LookAt:=LookAts1(p), SearchOrder:=xlByColumns, _
                SearchDirection:=SearchDirections1(p), MatchCase:=False)
                
                wsPO.Cells(i, FoundPOColumn1.Column) = wsMOQ.Cells(q, FoundMOQColumn.Column)
            End If
        Next
                            
    Next
        
Next



兩個excel快速比對key值並撈回大量欄位值:
wsPO, wsRFQ是兩個sheet物件,將會以key值做比對,一旦比對到資料,就會把wsRFQ的多個欄位的value複製回wsPO裡面

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

If strPOFileToOpen = "False" Then
    MsgBox "選取 PO 的檔案失敗!.", vbExclamation, "Sorry!"
    Exit Sub
Else
    Set wkbPO = Workbooks.Open(strPOFileToOpen)
    'MsgBox "開啟 PO 的檔案成功!.", vbExclamation, "成功!"
End If

'開啟RFQ檔案
Dim wkbRFQ As Workbook
Dim strRFQFileToOpen 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)
    'MsgBox "開啟 RFQ 的檔案成功!.", vbExclamation, "成功!"
End If

Dim wsPO As Worksheet
Set wsPO = wkbPO.Worksheets(1)
If wsPO.FilterMode Then wsPO.ShowAllData
If wsPO.AutoFilterMode Then wsPO.AutoFilterMode = False

Dim wsRFQ As Worksheet
Set wsRFQ = wkbRFQ.Worksheets("AIT-New")
If wsRFQ.FilterMode Then wsRFQ.ShowAllData
If wsRFQ.AutoFilterMode Then wsRFQ.AutoFilterMode = False

'找出Part#欄位
Dim FoundPartNumber As Range
Set FoundPartNumber = wsPO.Rows("1:1").Find("Part#", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

Dim lastRowPO As Long
lastRowPO = wsPO.Cells(Rows.Count, FoundPartNumber.Column).End(xlUp).Row
Dim lastRowRFQ As Long
lastRowRFQ = wsRFQ.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastRowPO
               
    For ii = 2 To lastRowRFQ
        '到RFQ檔案對應key值之後給值
        Dim compareRFQ As String
        compareRFQ = wsRFQ.Cells(ii, 1)
        If LCase(wsPO.Cells(i, FoundCombinePNCUS.Column)) = LCase(compareRFQ) Then
                                                    
            '全自動全欄位給值
            Dim MappingPOColumns As Variant
            MappingPOColumns = Array("序數", "RS", "COST-UP", "RFQ", "End products code", "End products", "Subcode(Sub2)", "Endcode(EC2)", "EndCust(EC2)", _
            "MPS sales")
            Dim MappingRFQColumns As Variant
            MappingRFQColumns = Array("序數", "PRICE", "COST", "RFQNO", "End product code", "EndProduct", "Subcode", "Endcode", "EndCust", _
            "MPSSales")
            Dim SearchDirections As Variant '1:next, 2:previous
            SearchDirections = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            Dim LookAts As Variant '1:xlWhole, 2:xlPart
            LookAts = Array(1, 2, 2, 1, 1, 1, 2, 2, 1, 1)
            For j = LBound(MappingPOColumns) To UBound(MappingPOColumns)
                Dim FoundPOColumn As Range
                Set FoundPOColumn = wsPO.Rows("1:1").Find(MappingPOColumns(j), LookIn:=xlValues, LookAt:=LookAts(j), SearchOrder:=xlByColumns, _
                SearchDirection:=SearchDirections(j), MatchCase:=False)
                Dim FoundRFQColumn As Range
                Set FoundRFQColumn = wsRFQ.Rows("1:1").Find(MappingRFQColumns(j), LookIn:=xlValues, LookAt:=LookAts(j), SearchOrder:=xlByColumns, _
                SearchDirection:=SearchDirections(j), MatchCase:=False)
                
                wsPO.Cells(i, FoundPOColumn.Column) = wsRFQ.Cells(ii, FoundRFQColumn.Column)
                    
            Next
                                        
            Exit For
        End If
                                                        
    Next
    
    
        
Next



整列儲存格上色:

'取得最後一列
Dim lastColumnTemplate As Long
lastColumnTemplate = wsTemplate.Cells(1, Columns.Count).End(xlToLeft).Column
Dim templateRowNo As Integer
templateRowNo = 2
wsTemplate.Range(Col_Letter(1) & templateRowNo & ":" & _
	Col_Letter(lastColumnTemplate) & templateRowNo).Interior.Color = vbRed

'欄位數字轉英文
Function Col_Letter(lngCol As Long) As String
	Dim vArr
	vArr = Split(Cells(1, lngCol).Address(True, False), "$")
	Col_Letter = vArr(0)
End Function						


設定整列的框線:

'開啟 範本檔檔案
Dim wkbTemplate As Workbook
Dim strTemplateFileToOpen As String
strTemplateFileToOpen = ""
'透過dialog視窗取得檔案名稱
strTemplateFileToOpen = Application.GetOpenFilename _
(Title:="請選擇 (MPS_POA) 的空白範本檔", _
FileFilter:="Excel Files *.xls* (*.xls*),")

If strTemplateFileToOpen = "False" Then
	MsgBox "選取 範本檔 失敗!.", vbExclamation, "Sorry!"
	Exit Sub
Else
	Set wkbTemplate = Workbooks.Open(strTemplateFileToOpen)
	
End If
   
Dim wsTemplate As Worksheet
Set wsTemplate = wkbTemplate.Worksheets(1)
If wsTemplate.FilterMode Then wsTemplate.ShowAllData
If wsTemplate.AutoFilterMode Then wsTemplate.AutoFilterMode = False
	
Dim lastColumnTemplate As Long '取得最後一個column
lastColumnTemplate = wsTemplate.Cells(1, Columns.Count).End(xlToLeft).Column

Dim templateRowNo As Integer
templateRowNo = 2 '第幾列請自行設定喔
	
'設定整列的框線
wsTemplate.Range("A" & templateRowNo & ":" & Col_Letter(lastColumnTemplate) & templateRowNo).Borders.LineStyle = xlContinuous

Function Col_Letter(lngCol As Long) As String
	Dim vArr
	vArr = Split(Cells(1, lngCol).Address(True, False), "$")
	Col_Letter = vArr(0)
End Function						



參考資料:
自己的工作經驗