比較之前拆分單元格列值

Question

我有兩個電子表格，vda.xlsx和main.xlsm。目前，我在比較值：

main.xlsm J列

與

vda.xlsx列A

要查看是否有匹配。如果找到匹配，則列中的值以紅色突出顯示。

但是，vda.xlsx列A中的數據格式已更改。

它曾經像這樣

現在它看起來像這樣

測試\ 1234或最佳\ 1234或玩笑\ 1234 - 它可能是什麼...

Sp我需要拆分Test \ 1234的「\」 「並提取1234作比較。

任何想法我可以做到這一點。這是到目前爲止我的代碼：

Sub VDA_Update() 

Dim wshT As Worksheet 
    Dim wbk As Workbook 
    Dim wshS As Worksheet 
    Dim r As Long 
    Dim m As Long 
    Dim cel As Range 
    Application.ScreenUpdating = False 
    Set wshT = ThisWorkbook.Worksheets("Master") 
    On Error Resume Next 

    ' Check whether vda.xlsx is already open 
    Set wbk = Workbooks("vda.xlsx") 
     On Error GoTo 0 
     If wbk Is Nothing Then 
     ' If not, open it 
     Set wbk = Workbooks.Open("C:\Working\vda_test.xlsx") 
    End If 

    ' Set worksheet on vda.xlsx 
    Set wshS = wbk.Worksheets("imac01") 
    m = wshT.Cells(wshT.Rows.Count, 1).End(xlUp).Row 

    ' Loop though cells in column J on main.xlsm 
    For r = 1 To m 
     ' Can we find the value in column C of vda.xlsx? 

     Set cel = wshS.Columns(1).Find(What:=wshT.Cells(r, 10).Value, _ 
      LookAt:=xlWhole, MatchCase:=False) 

     If Not cel Is Nothing Then 

      ' If we find a match, then change the text to red 
      wshT.Cells(r, 10).Font.ColorIndex = 3 

     End If 
    Next r 

    Application.ScreenUpdating = True 

End Sub 

Answer 1

使用Split(CellValue, "\")得到一個數組，然後在數組中檢索最後一個項目。

變化：

' Loop though cells in column J on main.xlsm 
For r = 1 To m 
    ' Can we find the value in column C of vda.xlsx? 

    Set cel = wshS.Columns(1).Find(What:=wshT.Cells(r, 10).Value, _ 
     LookAt:=xlWhole, MatchCase:=False) 

    If Not cel Is Nothing Then 

     ' If we find a match, then change the text to red 
     wshT.Cells(r, 10).Font.ColorIndex = 3 

    End If 
Next r 

喜歡的東西：

' Loop though cells in column A on vda.xlsx 
For r = 1 To m 
    ' Can we find the value in column J of main.xlsm? 

    cellSplit = Split(wshS.Cells(r, 1).Value, "\") 
    Set cel = wshT.Columns(10).Find(cellSplit(UBound(cellSplit)), _ 
     LookAt:=xlWhole, MatchCase:=False) 

    If Not cel Is Nothing Then 

     ' If we find a match, then change the text to red 
     cel.Cells(1, 1).Font.ColorIndex = 3 

    End If 
Next r