Замена значений в столбце в зависимости от условия совпадения с использованием VBA

Question

Test_File Я пытаюсь заменить значения в столбце определенным условием: IF (C37808 = $ Q $ 1, D37808,0);Поэтому я скопировал отфильтрованный столбец D (D31924: D37908) и вставил его в другой столбец F. Моя цель - заменить соответствующие значения столбца F на основе условия IF-ELSE, упомянутого выше.

Первый вызовнаходил диапазон столбца 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

После выполнения кода я получаю единственное 1-е значение столбца D во всех ячейках столбца F. Буду очень признателен, если кто-нибудь сможет помочь мне решить эту проблему.Прилагается скриншот результата. результат

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

Теперь он вставляет разные значения, но, похоже, выбирает их из неправильных строк.Причина в том, что вы устанавливаете диапазоны.Я не верю, что это работает, как вы ожидаете, и я не могу проверить это, потому что у меня нет данных.Два факта: -

1. Диапазон, определенный как начинающийся с любой ячейки (например, ActiveSheet.AutoFilter.Range.SpecialCells (xlCellTypeVisible) .Areas (2) (1, 3) ) и заканчивается в последней использованной ячейке, будет включать в себя как видимые, так и невидимые ячейки.
2. Номер индекса ячеек в ваших диапазонах не выровнен с номерами строк на рабочем листе.

Задача на самом деле очень проста.Просто выполните цикл по всем ячейкам в столбце F, и, если экзамен соответствует определенным критериям, скопируйте значение из столбца D в той же строке.Номер строки никогда не подвергается сомнению, если обрабатывается таким образом.Поэтому, если мое решение не будет скопировано из правильной строки, я предлагаю вам перепроектировать цикл.