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

时间:2017-01-13 03:56:03

标签: excel vba excel-vba

我在工作表“test”中有两列。我们假设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

2 个答案:

答案 0 :(得分:1)

试试此代码

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

答案 1 :(得分:0)

您可以使用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