根据另一列中的条件在上面和下面填充空白单元格
我有以下的列和值：
User ID Input B Input C Input D ... Input ZZ id_value1 c_value1 id_value1 id_value1 d_value1 zz_value1 id_value1 b_value1 id_value2 b_value2 id_value2 zz_value2 id_value2 c_value2 d_value2 id_value2 id_value2 id_value3 c_value3 id_value3 b_value3 d_value3 zz_value3 id_value4 id_value4 b_value4 id_value4 zz_value4 id_value4 c_value4 d_value4 id_value4 我想达到以下目的：
User ID Input B Input C Input D ... Input ZZ id_value1 b_value1 c_value1 d_value1 zz_value1 id_value1 b_value1 c_value1 d_value1 zz_value1 id_value1 b_value1 c_value1 d_value1 zz_value1 id_value1 b_value1 c_value1 d_value1 zz_value1 id_value1 b_value1 c_value1 d_value1 zz_value1 id_value2 b_value2 c_value2 d_value2 zz_value2 id_value2 b_value2 c_value2 d_value2 zz_value2 id_value2 b_value2 c_value2 d_value2 zz_value2 id_value2 b_value2 c_value2 d_value2 zz_value2 id_value2 b_value2 c_value2 d_value2 zz_value2 id_value3 b_value3 c_value3 d_value3 zz_value3 id_value3 b_value3 c_value3 d_value3 zz_value3 id_value4 b_value4 c_value4 d_value4 zz_value4 id_value4 b_value4 c_value4 d_value4 zz_value4 id_value4 b_value4 c_value4 d_value4 zz_value4 id_value4 b_value4 c_value4 d_value4 zz_value4 id_value4 b_value4 c_value4 d_value4 zz_value4
目标是这样的：
在列A中每行中具有相同值的行（这些行是连续的）内，使用列B：ZZ中存在的值的单个实例来向上和向下填充这些列中的任何空白单元格。
换句话说，对于列B：ZZ中的任何值，向上和向下填充该值，直到列A中的值改变。
换一种说法，对于任何空白单元格，在rc1中find一个非空白单元格，并在其中find一个匹配的值，并获取该单元格的值。
我的伪代码方法如下：
for each blankcell: find nonblank above if nonblank.rc1 == blankcell.rc1: blankcell == nonblank else find nonblank below if nonblank.rc1 == blankcell.rc1: blankcell == nonblank else do nothing
这似乎相对简单，但我不知道如何在VBA中实现它。
我一直在试图用@ Jeeped的代码来解决类似的问题，但还没有成功。
Private Sub FillColBlanksSpecial2() Dim wks As Worksheet Dim rng As Range Dim rng2 As Range Dim blnk As Range Dim LastRow As Long Dim col As Long Dim lRows As Long Dim lLimit As Long Dim lCount As Long On Error Resume Next lRows = 2 lLimit = 1000 Set wks = ActiveSheet With wks With .Cells(1, 1).CurrentRegion With .Columns("B:ZZ") If CBool(Application.CountBlank(.Cells)) Then For Each blnk In .SpecialCells(xlCellTypeBlanks) blnk.FormulaR1C1 = "=if(countifs(r1c1:r[-1]c1, rc1, r1c:r[-1]c, ""<>""), index(r1c:r[-1]c, match(rc1, r1c1:r[-1]c2, 0)), if(countifs(r[1]c1:r9999c1, rc1, r[1]c:r9999c, ""<>""), index(r[1]c:r9999c, min(index(row(r:r9998)-row(r[-1])+((r[1]c1:r9999c1<>rc1)+not(len(r[1]c:r9999c)))*1e+99, , ))), r[-1]c))" blnk.Value = blnk.Value Next blnk End If End With End With End With End Sub
据我所知，这个代码基于列A中的值向上填充，但向下填充，直到find任何新值（不依赖于列A的条件）。 由于我对min（）函数的逻辑没有一个理解，所以我也犹豫要使用代码。
任何深入了解如何实现我的伪代码方法或任何其他方法将不胜感激。
也许尝试像下面的东西？
Sub FillValues() Dim tempRange As Range, tempArray As Variant, rowStart As Long, rowEnd As Long, lastRow As Long, lastCol As Long Dim i As Long, j As Long, tempValue As Variant ' The assumption is that we are starting in row 2, and go as far down as there are cells in Column A ' Also that we are using Column A as a reference. ' So we start by getting this range and assigning it to our variable. lastRow = Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row lastCol = ActiveSheet.UsedRange.Columns.Count Set tempRange = Intersect(ActiveSheet.UsedRange, Range("A2:A" & lastRow).EntireRow) ' We are going to assume that we are not concerned about pasting formats etc. '(If we are concerned with that, we would need to change our code) 'Set the tempArray to be this range that we acquired above. tempArray = tempRange.Value rowStart = 1 While rowStart <= lastRow rowEnd = rowStart ' First get the rows we are going to be looking at ' Keep iterating rowEnd until we find a new value, or we reach the end While tempArray(rowEnd, 1) = tempArray(rowStart, 1) And rowEnd < lastRow rowEnd = rowEnd + 1 Wend ' If we did reach a new value, go back one to get the real row range. If Not tempArray(rowEnd, 1) = tempArray(rowStart, 1) Then rowEnd = rowEnd - 1 ' Now that we have a range, we loop over the row range and column range. ' For each column For j = 2 To lastCol ' Cycle through the rows to find an acceptable value tempValue = "" For i = rowStart To rowEnd If Not Len(tempArray(i, j)) = 0 Then tempValue = tempArray(i, j): Exit For Next i ' If we found a value, populate the whole section accordingly If Not Len(tempValue) = 0 Then For i = rowStart To rowEnd tempArray(i, j) = tempValue Next i End If Next j ' After we did this for each column, we now need to iterate to the next section rowStart = rowEnd + 1 Wend ' Finally we put the new data back into the sheet tempRange = tempArray ' And clear the variables Set tempRange = Nothing: Set tempArray = Nothing End Sub
这个简单的公式填充随后从公式到价值的逆转应该就足够了。
Sub blah() With Worksheets("Sheet7") With .Cells(1, 1).CurrentRegion If CBool(Application.CountBlank(.Cells)) Then With .Cells.SpecialCells(xlCellTypeBlanks) .FormulaR1C1 = _ "=LOWER(SUBSTITUTE(RC1, ""id_"", SUBSTITUTE(ADDRESS(1, COLUMN(), 4, 1) & CHAR(95), 1, """")))" End With End If .Cells = .Cells.Value End With End With End Sub
我希望你的实际数据遵循你的样本数据展示的模式。
