Question

我有以下列和值：

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中使用匹配值找到上方或下方的非空单元格并获取该单元格的值。

我的伪代码方法如下：

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's code以解决类似的问题，但没有成功。

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列中的值向上填充，但向下填充，直到找到任何新值（不依赖于A列条件）。我也对使用代码犹豫不决，因为我对min（）函数的逻辑没有理解。

对于如何实现我的伪代码方法或任何替代方法的任何见解将不胜感激。

Answer 1

也许尝试类似下面的内容？

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

Answer 2

这个简单的公式填充随后从公式到值的回复就足够了。

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

我希望您的实际数据遵循样本数据显示的模式。

根据另一列

2 个答案: