Код 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