在比较之前拆分单元格列值

我有两个电子表格，vda.xlsx和main.xlsm。 目前我正在比较的价值在：

main.xlsm列J

同

vda.xlsx列A

看看是否有匹配。 如果find匹配，则列中的值将以红色突出显示。

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

它过去看起来像这样

1234

现在看起来像这样

Test \ 1234或Best \ 1234或Jest \ 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