我試圖比較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