在VBA中通过计算x和y单元的平均值来减少矩阵中的行数和列数

Question

第一次在这里发帖。我对VBA编程有一点了解，但显然还不够。我已经创建了一个excel电子表格，它自动从文本文件导入测量数据，并将数据转换为矩阵，因此我可以将其用于3D曲面图。不幸的是，有时这个矩阵有超过255行/列，超过了3d曲面图的最大值。

因此，我要做的是创建一个Sub，它通过取x×y单元的平均值并将它们写入到另一张图纸上的不同“矩阵”中，来减少3d曲面图的单元数量。

因此，我尝试创建一个具有4个输入的Sub :源工作表的名称、目标工作表的名称、x比率和y比率。X比率是要合并的水平单元的数目，y比率是要合并的垂直单元的数目。因此，如果x-ratio =3和y-ratio = 2，则Sub应该从源工作表中提取单元格A1:B3，计算平均值，并将其写入目标工作表的单元格A1中，A4:B6到A2。类似地，C1:D3需要转到B1，依此类推...源表中的行数和列数每次都不同。

还有一个问题是，如果我将x-ratio定义为3，但在行的末尾只剩下2列，那么它应该只计算最后2列的平均值。如果没有足够的行，情况也是如此。

下面是我写的代码：

Public Sub ChngGraphRes(Sourcegraph As String, Destgraph As String, ratio As Long, yRatio As Long)

    Dim SrcRng As Range
    Dim CurPos As Range
    Dim SrcAvg As Double
    Dim DestRng As Range
    Dim sRw As Long
    Dim dRw As Long
    Dim Cl As Long
    
    Set Sht = ThisWorkbook.Sheets(Destgraph)
    Sht.Cells.Clear
    
    Dim lstRow As Long
    Dim lstCol As Long
    lstRow = Worksheets(Sourcegraph).Range("a1").End(xlDown).Row - 1
    lstCol = Worksheets(Sourcegraph).Range("a1").End(xlToRight).Column - 1
    
    Set CurPos = Range("'" & Sourcegraph & "'!A1")
    Set DestRng = Range("'" & Destgraph & "'!A1")
    Do While CurPos.Row < lstRow - yRatio
        Do While CurPos.Column < lstCol - xRatio
            SrcRng = Range(CurPos).Resize(yRatio, xRatio)
            SrcAvg = WorksheetFunction.Average(Range(SrcRng))
            DestRng.Value = SrcAvg
            CurPos = CurPos.Offset(0, xRatio)
            DestRng = DestRng.Offset(0, 1)
        Loop
        SrcRng = Range(CurPos).Resize(yRatio, lstCol - CurPos.Column)
        SrcAvg = WorksheetFunction.Average(Range(SrcRng))
        DestRng.Value = SrcAvg
        sRw = CurPos.Row
        dRw = DestRng.Row
        CurPos = Range(Sourcegraph & "!A1")
        CurPos = CurPos.Offset(sRw + yRatio, 0)
        DestRng = Range(Destgraph & "!A1")
        DestRng = DestRng.offest(dRw + 1, 0)
    Loop
    Do While CurPos.Column < lstCol - xRatio
        SrcRng = Range(CurPos).Resize(lstRow - CurPos.Row, xRatio)
        SrcAvg = WorksheetFunction.Average(Range(SrcRng))
        DestRng.Value = SrcAvg
        CurPos = CurPos.Offset(0, xRatio)
        DestRng = DestRng.Offset(0, 1)
    Loop
    SrcRng = Range(CurPos).Resize(lstRow - CurPos.Row, lstCol - CurPos.Column)
    SrcAvg = WorksheetFunction.Average(Range(SrcRng))
    DestRng.Value = SrcAvg            
            
End Sub

我可能用完全错误的方式来做这件事，因为我得到了各种各样的错误，而我不知道如何修复它们。

Answer 1

谢谢，freeflow

新的一天，新的想法。我采纳了你的建议，迈出了很小的一步。我从头开始编写代码，这次不是使用整个方法处理范围，而是处理单元格(行、列)。容易得多，也不容易出错。

下面是工作代码：

Public Sub ChngGraphRes(srcGraph As String, destGraph As String, xRatio As Long, yRatio As Long)
          
    Dim srcSht As Worksheet
    Dim destSht As Worksheet
    Dim lastRw As Long
    Dim lastCl As Long
    Dim curSrcRw As Long
    Dim curSrcCl As Long
    Dim curDestRw As Long
    Dim curDestCl As Long
    
    'Set source and destination sheets
    Set srcSht = ThisWorkbook.Sheets(srcGraph)
    Set destSht = ThisWorkbook.Sheets(destGraph)
    
    'Clear destination sheet
    destSht.Cells.Clear
        
    'Check how many rows and columns in source sheet
    lastRw = srcSht.Range("A1").End(xlDown).Row
    lastCl = srcSht.Range("A1").End(xlToRight).Column
    
    'Set start position
    curSrcRw = 2
    curSrcCl = 2
    curDestRw = 1
    curDestCl = 1
    
    'Calculate averages
    With srcSht
        Do While curSrcRw < lastRw - yRatio
            Do While curSrcCl < lastCl - xRatio
                destSht.Cells(curDestRw, curDestCl) = WorksheetFunction.Average(.Cells(curSrcRw, curSrcCl).Resize(yRatio, xRatio))
                curSrcCl = curSrcCl + xRatio
                curDestCl = curDestCl + 1
            Loop
            destSht.Cells(curDestRw, curDestCl) = WorksheetFunction.Average(.Cells(curSrcRw, curSrcCl).Resize(yRatio, lastCl - curSrcCl + 1))
            curSrcRw = curSrcRw + yRatio
            curSrcCl = 2
            curDestRw = curDestRw + 1
            curDestCl = 1
        Loop
        Do While curSrcCl < lastCl - xRatio
                destSht.Cells(curDestRw, curDestCl) = WorksheetFunction.Average(.Cells(curSrcRw, curSrcCl).Resize(lastRw - curSrcRw + 1, xRatio))
                curSrcCl = curSrcCl + xRatio
                curDestCl = curDestCl + 1
        Loop
        destSht.Cells(curDestRw, curDestCl) = WorksheetFunction.Average(.Cells(curSrcRw, curSrcCl).Resize(lastRw - curSrcRw + 1, lastCl - curSrcCl + 1))
    End With
    
End Sub