Vba找到第一个空单元格并平均它上面的4个单元格并将值粘贴到另一个单元格中

Posted 2023-02-24

【中文标题】Vba找到第一个空单元格并平均它上面的4个单元格并将值粘贴到另一个单元格中

【英文标题】：Vba to find first empty cell and average the 4 cells above it and paste value in another cell

【发布时间】：2014-08-19 19:19:23

【问题描述】：

您好，我的 vba 代码有问题。我希望它搜索第十三列（列 M），直到找到一个空白单元格。在该空白单元格中取其上方 4 个单元格的平均值。然后取该值并将其粘贴到单元格 D86 中。然后做同样的事情；转到 M 列找到第一个空单元格，在第一个空单元格中，现在取其上方 8 个单元格的平均值并将该值粘贴到 D87 中。同样的事情，但随后将 13 个单元格向上粘贴到 D88 中。如果有人可以帮助我解决这个问题，我将不胜感激，由于某种原因我无法弄清楚。谢谢，如果你还需要什么，尽管问。

【问题讨论】：

启动宏记录并完全按照您的描述执行 - 最好使用键盘（例如，Ctrl-Down 查找下一个空白单元格，移动箭头选择范围等）。然后查看生成的宏并根据您的需要进行修改。如果您遇到困难，请向我们展示代码，我们将进一步提供帮助！

【参考方案1】：

我的解决方案（从原帖中删除）：

Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
Dim FormulaWriter As String
Dim currentRowValue As String
Dim Thirteenback As Integer
Dim Eightback As Integer
Dim Fourback As Integer
Dim Oneback As Integer
Dim EndCol As Integer
    sourceCol = 3   'column C has a value of 3
    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

    'for every row, find the first blank cell and select it
    For currentRow = 2 To rowCount
        currentRowValue = Cells(currentRow, sourceCol).Value
        If IsEmpty(currentRowValue) Or currentRowValue = "" Then
        Cells(currentRow, sourceCol).Select
            Exit For
        End If
    Next
    Thirteenback = currentRow - 13
    Eightback = currentRow - 8
    Fourback = currentRow - 4
    Oneback = currentRow - 1
If Fourback < 4 Then
                Range("D86") = "=IFERROR(AVERAGE(M4" + ":" + "M7), 0)"
            Else
                FormulaWriter = "=IFERROR(AVERAGE(M" + CStr(Fourback) + ":" + "M" + CStr(Oneback) + "), 0)"
                Range("D86") = FormulaWriter
End If
If Eightback < 8 Then
                Range("D87") = "=IFERROR(AVERAGE(M4" + ":" + "M11), 0)"
              Else
                FormulaWriter = "=IFERROR(AVERAGE(M" + CStr(Eightback) + ":" + "M" + CStr(Oneback) + "), 0)"
                Range("D87") = FormulaWriter
End If
If Thirteenback < 13 Then
                Range("D88") = "=IFERROR(AVERAGE(M4" + ":" + "M16), 0)"
            Else
                FormulaWriter = "=IFERROR(AVERAGE(M" + CStr(Thirteenback) + ":" + "M" + CStr(Oneback) + "), 0)"
                Range("D88") = FormulaWriter
End If
Range("D86:D88").Select
Selection.AutoFill Destination:=Range("D86:E88"), Type:=xlFillDefault
End Sub