Код VBA для пропуска определенных значений и замены на последующее квалификационное значение

Добрый день,

Я очень новый в кодировании и совершенно новый в кодировании вещей с помощью макросов vba. После того, как я обнаружил полезность vba в excel, я теперь прилагаю усилия, чтобы узнать больше об этом. Любая помощь была бы очень признательна.

Это код, с которым я работаю до сих пор:

Option Explicit

Const initrow As Integer = 3
Const ENDROW As Long = 65536
Const PrimaryLengthCol As Integer = 1 '"A"

Sub Test()

    Dim lastrow As Double
    Dim i As Double
    Dim irow As Double

    lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    Application.ScreenUpdating = False

    irow = 0
    i = 0
    For i = 0 To lastrow
        If Cells(initrow + irow, PrimaryLengthCol + 2) = "BLANK" Then
            Continue For
            Cells(initrow + i, PrimaryLengthCol + 3).Value = Cells(initrow + irow, PrimaryLengthCol + 2).Value
        End If
    Next

End Sub

Таким образом, по существу проблема, с которой я сталкиваюсь, заключается в следующем:

У меня есть следующее В столбце » A «(входной столбец):

  • 0
  • 14.155
  • 14.128
  • 15.589
  • ПУСТО
  • ПУСТО
  • ПУСТО
  • 15.158

Мне нужно, чтобы код vba прошел через каждую ячейку, и если ячейка равна «пустой» (текстовая строка), то соответствующая ячейка примет следующий номер. Кроме того, если значение из столбца «A» равно нулю, то выходные данные равны «void» в столбце «B».

Таким образом, желаемый выход в столбце » B » (выходной столбец) должен быть:

  • Пустота
  • 14.155
  • 14.128
  • 15.589
  • 15.158
  • 15.158
  • 15.158
  • 15.158

Последний критерий заключается в том, что если ячейкам в столбце «A», равному «пустому», предшествовало нулевое значение в предыдущей ячейке, то эти «пустые» также будут равны значению «пустые» в выходном столбце » B» :

Таким образом, если столбец «A» имел этот сценарий:

  • 0
  • ПУСТО
  • ПУСТО

Выходной столбец «B» должен быть:

  • пустота
  • пустота
  • пустота

Я не уверен, как применить Continue For, так как я хочу, чтобы цикл «пропускал» по «пустым» ячейкам для следующей итерации, но все еще заполнял соответствующее значение в столбце «B» с последующим квалификационным значением. Я бы предпочел завершить это через vba, потому что я снова пытаюсь выучить язык, поэтому я заставляю себя увеличить свое воздействие на него.

Еще раз буду признателен за любую помощь в этом вопросе.

Спасибо!

2 ответа

  1. Вот немного другой подход, который может упростить использование и изменение (не протестирован):

    Dim cell As Range
    Set cell = Cells(Rows.Count, "A").End(xlUp) ' last cell
    
    While cell.Row > 2                          ' loop until row 3 
        If cell = 0 Then
            cell(, 2) = "Void"                  ' cell(, 2) is the cell on the right of cell
        Else If cell = "BLANK" Then
            cell(, 2) = cell(2)                 ' value from the cell below
        Else 
            cell(, 2) = cell                    ' else just use the same value 
        End If
    
        Set cell = cell(0)                      ' move to the cell above
    Wend
    

    Более продвинутый подход с Формулой Excel R1C1 (также не протестирован):

    Dim colB As Range
    Set colB = ThisWorkbook.Worksheets("Sheet1").Range("A3").CurrentRegion.Offset(,1).Resize(,1)
    
    colB.FormulaR1C1 = "=IF(RC[-1]=0, ""Void"", IF(RC[-1]=""BLANK"", R[1]C[-1], RC[-1]))"
    
    colB.Value2 = colB.Value2  ' optional to convert the formulas to values
    

    .CurrentRegion получает прямоугольный диапазон, окруженный пустыми ячейками (аналогично щелчку по ячейке A3и нажатию Ctrl + A), затем .Offset(,1)должен переместить диапазон в столбец B, и .Resize(,1)является необязательным, чтобы изменить размер диапазона в один столбец только в случае, если столбец B не пуст.

  2. Поэтому, основываясь на советах Slai, которые я очень ценил в сочетании с кодом, с которым я уже играл, проблема была решена с помощью следующего кода. Я должен был разделить его на 2 функции, чтобы выполнить все мои первоначальные критерии. Если у кого-то есть более эффективный способ решения проблемы, я буду более чем счастлив узнать об этом.

    Option Explicit
    
    Const initrow As Integer = 3
    Const ENDROW As Long = 65536
    Const PrimaryLengthCol As Integer = 1 '"A"
    
    Sub FirstIter()
    
    ' initial iteration that exacts value from the adjustment column
        Dim i As Double
        Dim irow As Double
    
        Worksheets(MatchMLWorksheet).Activate
        irow = 0
    
        While Not (IsEmpty(Cells(initrow + irow, PrimaryLengthCol + 2)))            ' loop until empty cell
            If Cells(initrow + irow, PrimaryLengthCol + 2).Value = 0 Then
                Cells(initrow + irow, PrimaryLengthCol + 2).Offset(, 1) = "Void"    ' cell.Offset(, 1) is the cell on the right
            ElseIf Cells(initrow + irow, PrimaryLengthCol + 2).Value = "BLANK" Then
                i = irow                           ' sets the count to where cell iteration is
                Do
                    i = i + 1                      ' increments the Do Until loop untils
                                                   ' it hits the first cell with "BLANK"
                Loop Until Cells(initrow + i, PrimaryLengthCol + 2).Value <> "BLANK" Or Cells(initrow + i, PrimaryLengthCol + 2).Value <> 0
    
                Cells(initrow + irow, PrimaryLengthCol + 2).Offset(, 1) = Cells(initrow + i, PrimaryLengthCol + 2).Value
                                                   ' Overall counter is at the iteration of "blank"
                                                   ' resets counter to match overall loop
            Else
                Cells(initrow + irow, PrimaryLengthCol + 2).Offset(, 1) = Cells(initrow + irow, PrimaryLengthCol + 2).Value    ' else just use the same value
            End If
    
            irow = irow + 1                        ' move to the cell below
        Wend
    
    End Sub
    
    Sub FinalIter()
    'Checks entire column to see if it contains any "BLANK"
    
        Worksheets(MatchMLWorksheet).Activate
    
        Dim num As Double
        num = 0
        Dim cell As Range
        Dim iMsg As Integer
        Dim b As Double
    
        Columns("D:D").Select
            Set cell = Selection.Find(What:="BLANK", After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
        If cell Is Nothing Then
            ' There are no more "BLANK"
            iMsg = MsgBox("There are no more BLANK values!", vbOKOnly)
        Else
            While Not (IsEmpty(Cells(initrow + num, PrimaryLengthCol + 3)))            ' loop until empty cell
                If Cells(initrow + num, PrimaryLengthCol + 3).Value = "BLANK" Then
                    b = num                           ' sets the count to where cell iteration is
                    Do
                        b = b + 1                      ' increments the Do Until loop untils
                                                       ' it hits the first cell with "BLANK"
                    Loop Until Cells(initrow + b, PrimaryLengthCol + 3).Value <> "BLANK"
    
                    Cells(initrow + num, PrimaryLengthCol + 3) = Cells(initrow + b, PrimaryLengthCol + 3).Value
                                                   ' Overall counter is at the iteration of "blank"
                                                   ' resets counter to match overall loop
                End If
    
                num = num + 1                        ' move to the cell below
            Wend
    
        End If
    
    End Sub