比较两列，并使用vba复制粘贴

我有一个表“testing”中的两列。 我们假设col C和D

C和D中的每一行都可能有“COMPATIBLE”或“NOT DETERMINED”或空白单元格。

我想比较col C和D，如果C有“COMPATIBLE”，D有“NOT DETERMINED”，那么“COMPATIBLE”应该粘贴到D中，反之亦然。

我有下面的代码，但不知道如何完成它：

Sub compare_cols() 'Get the last row Dim Report As Worksheet Dim i As Integer, j As Integer Dim lastRow As Integer Set Report = Excel.Worksheets("test") 'You could also use Excel.ActiveSheet _ if you always want this to run on the current sheet. lastRow = Report.UsedRange.Rows.Count Application.ScreenUpdating = False For i = 2 To lastRow For j = 2 To lastRow If Report.Cells(i, 1).Value = "COMPATIBLE" Then If InStr(1, Report.Cells(j, 2).Value, Report.Cells(i, 1).Value, vbTextCompare) > 0 

更新进度代码的工作：

 Option Explicit Sub compare_cols() With Worksheets("Latency") '<-.-| reference your worksheet With .Range("F1:G" & .UsedRange.Rows(.UsedRange.Rows.count).Row) '<--| reference its columns C:D range from row 1 down to worksheet last used row Correct .Cells, "COMPATIBLE", "Not Determind", 2 Correct .Cells, "Determind", "COMPATIBLE", 1 End With .AutoFilterMode = False End With End Sub Sub Correct(rng As Range, val1 As String, val2 As String, colToChangeIndex As Long) With rng '<--| reference passed range .AutoFilter Field:=1, Criteria1:=val1 '<--| filter referenced range on its 1st column with 'val1' .AutoFilter Field:=2, Criteria1:=val2 '<--| filter referenced range on its 2nd column with 'val2' If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any filterd cells other than header .Resize(.Rows.count - 1, 1).Offset(1, colToChangeIndex - 1).SpecialCells(xlCellTypeVisible).Value = "COMPATIBLE" '<--| write "COMPATIBLE" in column "D" End If End With End Sub 

Answer 1

你可以使用AutoFilter() ：

 Option Explicit Sub compare_cols() With Worksheets("test") '<-.-| reference your worksheet With .Range("C1:D" & .UsedRange.Rows(.UsedRange.Rows.Count).Row) '<--| reference its columns C:D range from row 1 down to worksheet last used row Correct .Cells, "COMPATIBLE", "NOT DETERMINED", 2 Correct .Cells, "NOT DETERMINED", "COMPATIBLE", 1 End With .AutoFilterMode = False End With End Sub Sub Correct(rng As Range, val1 As String, val2 As String, colToChangeIndex As Long) With rng '<--| reference passed range .AutoFilter Field:=1, Criteria1:=val1 '<--| filter referenced range on its 1st column with 'val1' .AutoFilter Field:=2, Criteria1:=val2 '<--| filter referenced range on its 2nd column with 'val2' If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any filterd cells other than header .Resize(.Rows.Count - 1, 1).Offset(1, colToChangeIndex - 1).SpecialCells(xlCellTypeVisible).Value = "COMPATIBLE" '<--| write "COMPATIBLE" in column "D" End If End With End Sub 

Answer 2

试试这个代码

 Sub CvalueAndDvalue() Dim cValue As Range, dValue As Range Dim Report As Worksheet Set Report = Excel.Worksheets("test") For i = 2 To Report.Range("C" & Rows.Count).End(xlUp).Row Set cValue = Report.Range("C" & i) Set dValue = Report.Range("D" & i) If (Trim(cValue) = "COMPATIBLE" And Trim(dValue) = "NOT DETERMINED") Then dValue = cValue ElseIf (Trim(dValue) = "COMPATIBLE" And Trim(cValue) = "NOT DETERMINED") Then cValue = dValue End If Next i End Sub