Question

Test_File我正在尝试将列中的值替换为特定条件： IF（C37808 = $ Q $ 1，D37808,0）;因此，我复制了已过滤的列D（D31924：D37908）并将其粘贴到另一列F。我的目标是根据上述IF-ELSE条件替换列F的相应值。

第一个挑战是定位列C和D的范围，因为它们是动态的，这意味着列C或D的第一个值可以基于过滤条件从第1行或第100行开始。我已经找到一种方法来定位该动态范围，所以在那里没有问题。现在，当我尝试替换列F的相应单元格中的值时，我看到它仅粘贴一个值。在下面共享代码段：

Sub Replacement()
        Dim rng1 As Range, rng2 As Range, rng3 As Range
        Dim v

        With ActiveSheet.AutoFilter.Range
                .SpecialCells(xlCellTypeVisible).Areas(2)(1, 3).Select
        End With

        Set rng1 = Range(Selection, Selection.End(xlDown)) 'Finding the range of column C from the filtered region
        rng1.Copy
        v = WorksheetFunction.Mode(rng1) 'finding the mode/highest occuring number in rng1

        Range("Q1").Value = v 'storing if for comparison purpose later

    'Navigating to column F    
        With ActiveSheet.AutoFilter.Range
                .SpecialCells(xlCellTypeVisible).Areas(2)(1, 3).Select
        End With

        ActiveCell.Offset(0, 3).PasteSpecial 'pasting the copied column C into column F

        With ActiveSheet.AutoFilter.Range
                .SpecialCells(xlCellTypeVisible).Areas(2)(1, 6).Select
        End With

        Set rng2 = Range(Selection, Selection.End(xlDown))  'storing the column F's range for replacing

        With ActiveSheet.AutoFilter.Range
                .SpecialCells(xlCellTypeVisible).Areas(2)(1, 4).Select
        End With

        Set rng3 = Range(Selection, Selection.End(xlDown))  'storing the column D's range for using in Column F
        'Looping through each element of column F now and matching against my condition
            For Each z1 In rng2
                If z1.Value = v Then
                    z1.Value = rng3.Value 'expectation is to implement the formula :IF(C37808=$Q$1,D37808,0)
                    Else: z1.Value = 0
                End If
        Next z1
    End Sub

执行代码后，我在列F的所有单元格中获得列D的唯一第一个值。如果有人可以帮助我解决此问题，我将不胜感激。附件是结果的屏幕截图。 result

Answer 1

我评论并重新编写了您的代码。现在看起来像这样。

Sub Replacement()

    Dim RngC As Range                       ' Range is in column C
    Dim RngF As Range                       ' use descriptive names
    Dim RngD As Range
    Dim Cell As Range
    Dim v As Variant


    ' don't Select anything
'    With ActiveSheet.AutoFilter.Range
'        .SpecialCells(xlCellTypeVisible).Areas(2)(1, 3).Select
'    End With

    ' the next line will produce an error if no filter is set
    On Error Resume Next
    Set RngC = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(2)(1, 3)
    If Err Then
        MsgBox "Please specify filter criteria", vbCritical, "Can't Proceed"
        Exit Sub
    End If

    On Error GoTo 0
    Set RngC = Range(RngC, RngC.End(xlDown)) 'Finding the range of column C from the filtered region
    v = WorksheetFunction.Mode(RngC) 'finding the mode/highest occuring number in RngC
    ' no need to write v to the sheet
'    Range("Q1").Value = v 'storing if for comparison purpose later


    'Navigating to column F         ' don't "navigate". Just address
'    With ActiveSheet.AutoFilter.Range
        ' this is the first cell of RngC
'            .SpecialCells(xlCellTypeVisible).Areas(2)(1, 3).Select
'    End With
'    ActiveCell.Offset(0, 3).PasteSpecial 'pasting the copied column C into column F
    RngC.Copy Destination:=RngC.Cells(1).Offset(0, 3)

    ' don't Select anything!
'    With ActiveSheet.AutoFilter.Range
'            .SpecialCells(xlCellTypeVisible).Areas(2)(1, 6).Select
'    End With

    Set RngF = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(2)(1, 6)
    ' as an alternative you might specify:-
    ' Set RngF = RngC.Offset(0, 3)
    Set RngF = Range(RngF, RngF.End(xlDown))  'storing the column F's range for replacing

'    With ActiveSheet.AutoFilter.Range
'            .SpecialCells(xlCellTypeVisible).Areas(2)(1, 4).Select
'    End With
'    Set RngD = Range(Selection, Selection.End(xlDown))  'storing the column D's range for using in Column F
    Set RngD = RngC.Offset(0, 1)



    ' Looping through each element of column F now and matching against my condition
    For Each Cell In RngF
        With Cell
            If .Value = v Then
                ' your line always inserts RngD.Value.
                ' Since RngD is an array but the cell can only take one value
                ' VBA inserts the first value of the array.
                ' z1.Value = RngD.Value 'expectation is to implement the formula :IF(C37808=$Q$1,D37808,0)
                .Value = RngD.Cells(.Row).Value
            Else
                .Value = 0
            End If
        End With
    Next Cell
End Sub

它现在粘贴不同的值，但似乎是从错误的行中选择了它们。原因是您设置范围的方法。我不相信它能像您期望的那样工作，并且我无法测试它，因为我没有数据。两个事实：-

一个范围定义为从任何单元格开始（例如 ActiveSheet.AutoFilter.Range.SpecialCells（xlCellTypeVisible）.Areas（2）（1，3）），并在最后使用的单元格处结束，将同时包含可见和不可见的单元格。
您范围内的单元格的索引号与工作表的行号不一致。

任务实际上非常简单。只需遍历F列中的所有单元格，如果检查符合某些条件，则将D列中的值复制到同一行中。如果以这种方式处理，则行号永远不会成为问题。因此，如果我的解决方案没有从正确的行中复制，建议您重新设计循环。

使用VBA根据匹配条件替换列中的值

1 个答案: