Question

我想使用我为每个整列开发的匹配函数及其中的数据。因此，当我指定

时，它目前工作正常

Sub CompareAndMove()

    Dim rng1 As Range, rng2 As Range, i As Long, iL As Long, var As Variant
        
    iL = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 2 To iL
        Set rng1 = Sheets("Sheet1").Range("A" & i)
        Set rng2 = Sheets("Sheet1").Range("C:C")
                
       
       var = Application.Match(rng1.Value, rng2, 1)
     
       If Not IsError(Application.Match(rng1.Value, rng2, 0)) Then
       bln = True
       
       If bln = True Then
                    
                    rng1.Interior.Color = RGB(255, 255, 0)
                    rng1.Copy
                    rng1.Offset(0, 1).PasteSpecial
                    
                    
        End If
        Set rng1 = Nothing
        Set rng2 = Nothing
        End If
        
    Next i

End Sub

但是我现在正试图浏览所有包含数据的列，直到完成为止，我正在努力通过使用下面的脚本来定义列。有什么建议吗？

Sub CompareAndMove()

    Dim rng1 As Range, rng2 As Range, i As Long, iL As Long, var As Variant, j As Long, jL As Long
        
    iL = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    jL = Sheets("Sheet1").Cells(1, .Columns.Count).End(xlToRight).Column
        
    For j = 3 To jL
    
    For i = 2 To iL
        Set rng1 = Sheets("Sheet1").Range("A" & i)
        Set rng2 = Sheets("Sheet1").Range("j:j")
                
       
       var = Application.Match(rng1.Value, rng2, 1)
     
       If Not IsError(Application.Match(rng1.Value, rng2, 0)) Then
       bln = True
       
       If bln = True Then
                    
                    rng1.Interior.Color = RGB(255, 255, 0)
                    rng1.Copy
                    rng1.Offset(0, 1).PasteSpecial
                    
                    
        End If
        Set rng1 = Nothing
        Set rng2 = Nothing
        End If
        
    Next i
    
'copy column B to another sheet, clear column B so it can start on new column

Next j


End Sub

Answer 1

Set rng2 = Sheets("Sheet1").Range("j:j")

应该是

Set rng2 = Sheets("Sheet1").Columns(j)

或

Set rng2 = Sheets("Sheet1").Range(j & ":" & j)

返工：

Sub CompareAndMove()

    Dim rng1 As Range, rng2 As Range, i As Long, iL As Long
    Dim var As Variant, j As Long, jL As Long, bln As Variant
    Dim sht As Worksheet

    Set sht = Sheets("Sheet1")
    iL = sht.Range("A" & sht.Rows.Count).End(xlUp).Row
    jL = sht.Cells(1, sht.Columns.Count).End(xlToRight).Column

    For j = 3 To jL
        'only need to set this when you swap columns...
        Set rng2 = sht.Range("j:j")

        For i = 2 To iL

           Set rng1 = sht.Range("A" & i)

           var = Application.Match(rng1.Value, rng2, 1) 'why this?

           If Not IsError(Application.Match(rng1.Value, rng2, 0)) Then
                bln = True
                With rng1
                    .Interior.Color = RGB(255, 255, 0)
                    .Copy .Offset(0, 1)
                End With
           End If

        Next i

    Next j
    'no need to set ranges to Nothing...

End Sub

为包含数据的每列执行设置任务

1 个答案: