我试图比较A-B列并突出显示相同的文本,但是使用某些文本完全不匹配的obove fomrulas。所以我使用表格(VBA macro to compare two columns and color highlight cell differences)代码,我修改了一些东西以适应我的应用程序,并找到任何需要的列(只需单击它)。就我而言,我在每列上使用大量不同数量的行。希望这有助于:
子ABTextCompare()
Dim Report As Worksheet
Dim i, j, colNum, vMatch As Integer
Dim lastRowA, lastRowB, lastRow, lastColumn As Integer
Dim ColumnUsage As String
Dim colA, colB, colC As String
Dim A, B, C As Variant
Set Report = Excel.ActiveSheet
vMatch = 1
'Select A and B Columns to compare
On Error Resume Next
Set A = Application.InputBox(Prompt:="Select column to compare", Title:="Column A", Type:=8)
If A Is Nothing Then Exit Sub
colA = Split(A(1).Address(1, 0), "$")(0)
Set B = Application.InputBox(Prompt:="Select column being searched", Title:="Column B", Type:=8)
If A Is Nothing Then Exit Sub
colB = Split(B(1).Address(1, 0), "$")(0)
'Select Column to show results
Set C = Application.InputBox("Select column to show results", "Results", Type:=8)
If C Is Nothing Then Exit Sub
colC = Split(C(1).Address(1, 0), "$")(0)
'Get Last Row
lastRowA = Report.Cells.Find("", Range(colA & 1), xlFormulas, xlByRows, xlPrevious).Row - 1 ' Last row in column A
lastRowB = Report.Cells.Find("", Range(colB & 1), xlFormulas, xlByRows, xlPrevious).Row - 1 ' Last row in column B
Application.ScreenUpdating = False
'***************************************************
For i = 2 To lastRowA
For j = 2 To lastRowB
If Report.Cells(i, A.Column).Value <> "" Then
If InStr(1, Report.Cells(j, B.Column).Value, Report.Cells(i, A.Column).Value, vbTextCompare) > 0 Then
vMatch = vMatch + 1
Report.Cells(i, A.Column).Interior.ColorIndex = 35 'Light green background
Range(colC & 1).Value = "Items Found"
Report.Cells(i, A.Column).Copy Destination:=Range(colC & vMatch)
Exit For
Else
'Do Nothing
End If
End If
Next j
Next i
If vMatch = 1 Then
MsgBox Prompt:="No Itmes Found", Buttons:=vbInformation
End If
'***************************************************
Application.ScreenUpdating = True
末次
嗨大卫, 这工作完美,谢谢! 只是想多说一句谢谢你解释公式在做什么,这对我将来会有很多帮助。 亲切的问候, 凯尔 – Izion 2012-04-04 10:43:43
我的荣幸。公平地说,我认为克里斯尼尔森的方法(已经提出)也可以工作,并且可能更优雅。 – David 2012-04-04 11:16:31