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

时间:2014-08-19 19:19:23

标签: excel-vba range average vba excel

您好我的vba代码有问题。我希望它搜索第十三列(列M),直到找到一个空白单元格。在该空白单元格中,取其上方4个单元格的平均值。然后取出该值并将其粘贴到单元格D86中。然后做同样的事情;转到列M找到第一个空单元格,在第一个空单元格中,现在取其上方8个单元格的平均值并将该值粘贴到D87中。同样的事情,然后13个细胞并粘贴到D88。如果有人能帮助我,我会感激不尽,因为某种原因,我无法理解。谢谢,如果你需要任何其他的东西,请问。

1 个答案:

答案 0 :(得分:0)

我的解决方案(从原始帖子中删除):

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