두 열을 비교하고 vba를 사용하여 붙여 넣기 복사

Question

"test"시트에 두 개의 열이 있습니다. C와 D를 가정 해 봅시다.

C와 D의 각 행에는 "COMPATIBLE"또는 "NOT DETERMINED"또는 빈 셀이있을 수 있습니다.

C와 D를 비교하고 C에 "COMPATIBLE"이 있고 D에 "NOT DETERMINED"가있는 경우 "COMPATIBLE"을 D에 붙여야하며 그 반대의 경우도 마찬가지입니다.

나는 코드 아래에있는, 그러나 확실하지 그것을 수행하는 방법 : PROGRESS 코드에서 작업을 업데이트

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