特定范围的总和,该特定范围随循环的每次迭代而变化

时间:2019-03-27 21:43:20

标签: excel vba loops copy paste

我有一张纸,每当我更改特定的单元格时,范围的值都会更改。假设单元格C8是一个人的身份,H列是计划的每月还款。我需要找到每月的总还款额,因此就C8的每个可能值(这实际上意味着每个人,因为您可以想到C8的不同值),我需要还款的集合,因此需要单元格Hi的集合。在第i行保持不变并更改单元格C8时,我总是需要求和。所以我实际上需要sum(Hi)(i常数,并且和的索引是单元格c8,所以如果c8取值从1到200,我需要sum(Hi(c8)),再次是第i行。Hi(c8)只是向您表明Hi取决于c8的值,单元格H10中的实际公式是INDEX('Sheet2'!R:R,MATCH('Sheet1'!$ C $ 8,'Sheet2'!F: F,0))))。 H11及以后的版本具有相同的公式,但有一点曲折,因为还款额并不总是相等的,但指数函数保持不变。

然后,将c8的所有可能值的H10总数粘贴到c17中,将H11的总数粘贴到C18等中。请在下面找到一些图片,也许有助于支持我尝试实现的目标。 enter image description here

我为此使用以下代码。请注意,上面的示例只是为了向您解释背景,更改的单元格和范围不同。

 sub sumloop()

 Application.ScreenUpdating = False
 Application.DisplayStatusBar = False


 Sheets("Sheet1").Range("C8").Value = 1


 Dim i, k As Integer

  i = 1


  k = Sheets("Sheet1").Range("C9").Value

  Dim LR As Long
  LR = Sheets("Sheet1").Range("C" & 
  Sheets("Sheet1").Rows.Count).End(xlUp).row

  Sheets("Sheet1").Range("C17:C" & LR).ClearContents

   Do While i <= k


   If (Sheets("Sheet1").Range("J9").Value = "") Then


           Sheets("Sheet1").Range("h10:h200").Copy
           Sheets("Sheet1").Range("c17").PasteSpecial 
    Paste:=xlValues, Operation:=xlAdd, SkipBlanks:= _
        False, Transpose:=False


   Else


           Sheets("Sheet1").Range("h9:h200").Copy
           Sheets("Sheet1").Range("c17").PasteSpecial 
   Paste:=xlValues, Operation:=xlAdd, SkipBlanks:= _
            False, Transpose:=False


End If





 Sheets("Sheet1").Range("C8").Value = Sheets("Sheet1").Range("C8").Value+1 


  i = i + 1

  Loop

 Sheets("Sheet1").Range("C8").Value = 1

 Application.ScreenUpdating = True
 Application.DisplayStatusBar = True

 End Sub

是否需要在循环内部使用,因为范围的第一个值的位置取决于某些与代码无关的条件。另外,k表示可能值的最大数量。我需要大约250。

虽然代码可以正常工作,但要花大约40秒才能运行单元格C8的84个值,而要花250个时间需要约1.5分钟。 h10:h100,非常类似于我对Sheet1.Range(C17:C&LR)所做的操作。再次没有重大变化。因为我是vba的新手,所以我不知道1.5分钟对于这样一个简单的代码是否足够多,但是对我来说似乎很多,对于单元格c8的250个不同值的10种不同组合,需要进行此分析大约15分钟。

如果有人能更快地建议我,我将不胜感激。

非常感谢您。

4 个答案:

答案 0 :(得分:0)

欢迎使用StackOverflow。 我必须承认我对您的叙述感到有些困惑,因为我不完全了解您是在做sum(a,b,c)还是sum(a(b,c),sum(d,e), F), ...)。 无论如何,使用数组可以极大地加快脚本运行速度。

使用VBA执行计算并不算慢,但是从Excel(与应用程序通信)中检索数据却很慢,并且很大程度上取决于“请求”的数量,而不是请求的数据量。

您可以使用数组一次从一个范围中请求数据,而不必分别请求每个单元格的值。

Dim Arr() As Variant
Arr = Range("A1:E999")

就这么简单。 试试看,如果您仍在挣扎,请告诉我们。


奖金

如果您不熟悉Arrays,请记住,您可以使用二维数组:

Dim 2DArray(0 to 10, 0 to 50)

或堆叠的数组(数组的数组):

Dim MyArray() as String
Dim StackedArray() as MyArray

Dim StackedArray() as Variant

您将需要一个2D数组来从一个范围中提取数据,但我觉得您可能需要一个2D数组来获取总和。

一些推荐的读物:https://excelmacromastery.com/excel-vba-array/

答案 1 :(得分:0)

好,几件事。

首先,Dim i, k As Integer并没有您认为的那样,您需要这样做:Dim i As Integer, k As Integer

其次,不要在VBA中使用整数,请使用Long,所以Dim i As Long, k As Long

第三次计算杀死了您。在代码的开头使用Application.Calculation = xlCalculationManual将其关闭,然后在代码的结尾使用Application.Calculation = xlCalculationAutomatic将其关闭。

现在为我们提供了非常快速的代码,但是它并没有在您需要它的每次迭代中更新的问题。您可以像这样计算范围:Sheets("Sheet1").Range("h10:h200").Calculate,因此请在复制范围之前将其放入

会有一个更快的方法来完成此操作,但是我似乎无法满足您的要求,所以我无能为力。

答案 2 :(得分:0)

这是一个完整的解决方案,在注释中有解释。 由于我们没有源电子表格,因此无法对此进行任何测试。

Option Explicit 'This forces you to declare all your varaibles correctly. It may seem annoying at first glance, but will quickly save you time in the future.

Sub sumloop()

    Application.ScreenUpdating = False
    'Application.DisplayStatusBar = False -> This is not noticely slowing down your code as soon as you do not refresh the StatusBar value for more than say 5-10 times per second.

    'Save the existing Calculation Mode to restore it at the end of the Macro
    Dim xlPreviousCalcMode As XlCalculation
    xlPreviousCalcMode = Application.Calculation
    Application.Calculation = xlCalculationManual

    'Conveniently store the Sheet into a variable. You might want to do the same with your cells, for example: MyCellWhichCounts = MySheet.Range("c17")
    Dim MySheet As Worksheet
    MySheet = ActiveWorkbook.Sheets("Sheet1")

    MySheet.Range("C8").Value2 = 1 'It is recommended to use.Value2 instead of .Value (notably in case your data type is Currency, but it is good practice to use that one all the time)

    Dim LR As Long
    LR = MySheet.Range("C" & MySheet.Rows.Count).End(xlUp).Row 'Be carefull with "MySheet.Rows.Count", it may go beyond your data range, for example if you modify the formatting of a cell below your "last" row.
    MySheet.Range("C17:C" & LR).Value2 = vbNullString 'It is recommended to use vbNullString instead of ""; although I agree it makes it more difficult to read.

    Dim i As Integer, k As Integer 'Integers are ok, just make sure you neer exceed 255
    k = MySheet.Range("C9").Value2
    For i = 1 To k 'Use a For whenever you can, it is easier to maintain (i.e. avoid errors and also for you to remember when you go back to it years later)

        'Little extra so you can track progress of your calcs
        Dim z As Integer
        z = 10 'This can have any value > 0. If the value is low, you will refresh your app often but it will slow down. If the value is high, it won't affect performance but your app might freeze and/or you will not have your Statusbar updated as often as you might like. As a rule of thumb, I aim to refresh around 5 times per seconds, which is enough for the end user not to notice anything.
        If i Mod z = 0 Then 'Each time i is a mutliple of z
            Application.StatusBar = "Calculating i = " & i & " of " & k 'We refresh the Statusbar
            DoEvents 'We prevent the Excel App to freeze and throw messages like: The application is not responding.
        End If

        'Set the range
        Dim MyResultRange As Range
        If (MySheet.Range("J9").Value2 = vbNullString) Then
            MyResultRange = MySheet.Range("h10:h200")
        Else
            MyResultRange = MySheet.Range("h9:h200")
        End If


        '# Extract Result Data
        MyResultRange.Calculate 'Refresh the Range values
        Dim MyResultData As Variant
        MyResultData = MyResultRange.Value2 'Store the values in VBA all at once

        '# Extract Original Data
        Dim MyOriginalRange as Range
        MyOriginalRange.Calculate
        MyOriginalRange = MySheet.Range("c17").Resize(MyResultRange.Rows.Count,MyResultRange.Columns.Count) 'This produces a Range of the same size as MyResultRange 
        Dim MyOriginalData as Variant
        MyOriginalData = MyOriginalRange.Value2

        '# Sum Both Data Arrays
        Dim MySumData() as Variant
        Redim MySumData(lbound(MyResultRange,1) to ubound(MyResultRange,1),lbound(MyResultRange,2) to ubound(MyResultRange,2))
        Dim j as long
        For j = lbound(MySumData,1) to ubound(MySumData,1)
            MySumData(j,1)= MyResultData(j,1) + MyOriginalData(j,1)
        Next j

        'Instead of the "For j = a to b", you could use this, but might be slower: MySumData = Application.WorksheetFunction.MMult(Array(1, 1), Array(MyResultData, MyOriginalData))

        MySheet.Range("C8").Value2 = MySheet.Range("C8").Value2 + 1

    Next i

 MySheet.Range("C8").Value2 = 1

 Application.ScreenUpdating = True
 Application.StatusBar = False 'Give back the status bar control to the Excel App
 Application.Calculation = xlPreviousCalcMode 'Do not forget to restore the Calculation Mode to its previous state

 End Sub

由OP添加(请参阅评论)

图像1在最初的问题中编写的代码。 enter image description here

图片2位于enter image description here上方的代码

答案 3 :(得分:0)

如何通过数据透视图(无VBA)实现相同目的

步骤1

首先,您必须以特定的方式组织数据,其中每一列都是一个字段,每一行都是一个数据条目。如果您不熟悉数据库,这是最棘手的问题,因为您可能会以不同的方式排列数据。

长话短说,我们将以您有3个客户和4个约会的示例为例。 这样便有12个数据条目,这些数据条目将为每个可能的客户ID和日期提供还款价值。

enter image description here

步骤2

选择该数据并插入数据透视图。 注意:您可以单独插入数据透视表,也可以单独插入数据透视图。我建议您同时插入这两个选项,因为在处理图表时,管理数据将更加直观。该表将在您更新图表的同时进行更新。

enter image description here

步骤3

确保已选中所有数据,包括决定每个字段名称(每一列的名称)的第一行。

enter image description here

步骤4

刚刚创建了一个新工作表,您可以看到您的PivotTble和PivotCharts都将出现在哪里。选择图表。

enter image description here

步骤5

将出现一个右边的菜单(它可能已经在那儿了,所以请确保选择了“图表”而不是“表”,因为该菜单会稍有不同)。

enter image description here

步骤6

将字段名称拖放到类别中,如图所示。 您在这里所做的就是告诉Excel您想查看哪些数据(值)以及如何将其细分(按日期和每个客户)。

enter image description here

步骤7

默认情况下,日期数据始终按四分位数和年份分组。要查看我们拥有数据的所有日期,可以单击表格数据旁边的[+]:这将同时显示表格和图表的详细信息。

enter image description here

步骤8

但是我们要完全摆脱四分位数和年份。为此,您需要右键单击表中日期列的任何值,然后选择显示的“取消分组”。

enter image description here

步骤9

您的数据现在看起来像这样。 请注意,时间轴未按比例绘制。例如,如果您有月度数据而缺少一个月,则不会有间隔。这是数据透视数据的困难之一。这是可以克服的,但这里不涉及主题。

enter image description here

步骤10

现在,我们希望有一个数据的累积视图,因此我们想使用Excel处理值的方式。 选择图表,然后在右面板中:右键单击“还款额”字段,然后选择“值字段设置”。

enter image description here

步骤11

在“将值显示为”选项卡中,选择“将值显示为”“运行初始输入”。 然后选择“日期”。 在这里,我们告诉Excel要显示的值应该是根据“日期”字段累计的累计总数。 按确定。

enter image description here

步骤12

您现在拥有想要的东西。如果在表中查找,则每个客户ID都有一列,每个日期都有一行。对于给定的日期,您具有由给定的客户ID进行的累计还款。在最右边,您具有总计,即在给定日期,所有客户ID值的总和。

步骤13

图表持续显示每个客户ID的累计付款,我们看不到总计。 为了实现此目的,只需从“字段”面板的“图例(系列)”类别区域中删除“客户ID”字段,如图所示。 (您可以取消选中“客户ID [x]”框,也可以将其从类别区域拖放到主列表区域)。

enter image description here

步骤14

现在,图表中只有总计。但为什么? 如果显示“总和”的“值字段设置”(步骤10),则第一个选项卡“汇总值依据”将告诉Excel当多个值满足相同的图例和轴值时该怎么做。 现在,我们从图例区域中删除了客户ID字段,对于每个日期,我们都有3个还款值(每个客户ID一个)。在字段设置中,我们告诉Excel使用“总和”。因此它将返回这三个值的总和。

enter image description here

但是您可以试一下并返回平均值,甚至可以使用“计数”,这将向您显示您有多少记录(返回3)。 这就是数据透视图如此强大的原因:只需单击几下和/或拖放,就可以为数据显示无数种不同的图形。

为了将来的兴趣,您应该在线查找“过滤器”和“插入切片器”(等效于过滤,但是会直接在图表上添加按钮:在向同事显示数据并将其从一种设置切换为另一种时非常有用)

希望这对您有帮助!