Question

我试图通过使用VBA在Excel中使用不同权重的约6,500个值的加权和。以下是我正在寻找的简化示例：

Simplified Example with Sample Data

我已经有了A列和B列，我正在寻找可以打印出C＃中加权总和＆＃34;中C列上面所见内容的VBA代码。例如，第一个＆＃34; 3＆＃34;印在＆＃34;加权和＆＃34;计算如下：（5 * 0.5）+（1 * 0.5）= 3.我想使这个动态变化，以便我可以改变权重（目前显示为50％以上）。

Answer 1

我希望你觉得这很有帮助。第一课：并非Excel中的所有内容都需要VBA，我创建了一个带有两个选项卡的Excel文件：

1。）示例 - 没有VBA |显示如何在没有VBA的情况下执行此操作，这是众多方法之一

2。）示例 - VBA |演示如何使用VBA执行此操作，这是众多方法之一

请记住Alt + F11打开编辑器以在运行任何宏之前查看源代码

可以从这里下载工作示例：

https://dl.dropboxusercontent.com/u/15166388/StackOverflow/Weighted-Sum-in-VBA/weighted-sum.xlsm

以下是代码：

Public Sub WeightedSum()
'---------------------------------------------------------------------------------------
' Method : WeightedSum
' Author : vicsar
' Date   : June/13/2016
' Purpose: Teach Basic VBA
' Ref.: https://stackoverflow.com/questions/37799607/weighted-sum-in-vba
' Working example can be downloaded from here:
' https://dl.dropboxusercontent.com/u/15166388/StackOverflow/Weighted-Sum-in-VBA/weighted-sum.xlsm
'---------------------------------------------------------------------------------------

    On Error GoTo MistHandler

    Dim lngLastRowInExcel As Long
    Dim lngLastRowContainingData As Long
    Dim lngCounter As Long


    ' Basic dummy proofing
    ' Check for headers
    If Range("A1").Value = vbNullString Then
        MsgBox "Unable to find headers. Please review the file and try again", vbCritical, "Error"
        Exit Sub
    End If

    ' Check for empty columns
    If Range("A2").Value = vbNullString Then
        MsgBox "Unable to find values in cell A2. Please review the file and try again", vbCritical, "Error"
        Exit Sub
    End If


    ' Since the following steps require many screens refreshes using this will make it run fast  You won't be able
    ' to see what the macro is doing, but it will run faster.
    Application.ScreenUpdating = False

    ' Defining the last row containign data
    ' Using this approach to make the macro backwards compatile with other versions of Excel
    ActiveCell.SpecialCells(xlLastCell).Select
    Selection.End(xlDown).Select
    lngLastRowInExcel = ActiveCell.Row
    Range("A" & lngLastRowInExcel).Select
    Selection.End(xlUp).Select
    lngLastRowContainingData = ActiveCell.Row

    Range("A2").Select

    ' Move selection two columns to the right
    ActiveCell.Offset(0, 2).Select

    ' This loop repeats the formula on every single row adjacent to a value
    For lngCounter = 1 To lngLastRowContainingData - 1
        ActiveCell.FormulaR1C1 = "=(RC[-2]*0.5)+(RC[-1]*0.5)"
        ActiveCell.Offset(1, 0).Select
    Next

    ' Removing formulas, replacing with values (optional)
    Columns("A:C").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

    ' Exit Excel's copy mode
    Application.CutCopyMode = False

    ' Go to A1, scroll to it
    Range("A1").Select
    Application.Goto ActiveCell, True

    ' Autofit columns
    Columns.EntireColumn.AutoFit

    ' Allowing screen updates again
    Application.ScreenUpdating = True


    On Error GoTo 0
    Exit Sub

    ' Error handler
MistHandler:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure WeightedSum of basMain", vbExclamation, " vicsar says"

End Sub

Answer 2

添加另一个代码段来回答smathu3的后续问题。请阅读代码注释并根据需要进行调整。

*我怎样才能让重量变得动态？这里你有权重作为代码的一部分：ActiveCell.FormulaR1C1 =“=（RC [-2] * 0.5）+（RC [-1] 0.5）”。如果权重可以显示为很好的单元格。 - smathu3

Public Sub WeightedSumDynamicWeights()
'---------------------------------------------------------------------------------------
' Method : WeightedSumDynamicWeights
' Author : vicsar
' Date   : June/13/2016
' Purpose: Teach Basic VBA
' Ref.: https://stackoverflow.com/questions/37799607/weighted-sum-in-vba
' Working example can be downloaded from here:
' https://dl.dropboxusercontent.com/u/15166388/StackOverflow/Weighted-Sum-in-VBA/weighted-sum.xlsm
'---------------------------------------------------------------------------------------

    On Error GoTo MistHandler

    Dim lngLastRowInExcel As Long
    Dim lngLastRowContainingData As Long
    Dim lngCounter As Long

    ' Basic dummy proofing
    ' Check for headers
    If Range("A1").Value = vbNullString Then
        MsgBox "Unable to find headers. Please review the file and try again", vbCritical, "Error"
        Exit Sub
    End If

    ' Check for empty columns
    If Range("A2").Value = vbNullString Then
        MsgBox "Unable to find values in cell A2. Please review the file and try again", vbCritical, "Error"
        Exit Sub
    End If


    ' Since the following steps require many screens refreshes using this will make it run fast  You won't be able
    ' to see what the macro is doing, but it will run faster.
    Application.ScreenUpdating = False

    ' Defining the last row containign data
    ' Using this approach to make the macro backwards compatile with other versions of Excel
    ActiveCell.SpecialCells(xlLastCell).Select
    Selection.End(xlDown).Select
    lngLastRowInExcel = ActiveCell.Row
    Range("A" & lngLastRowInExcel).Select
    Selection.End(xlUp).Select
    lngLastRowContainingData = ActiveCell.Row

    Range("A2").Select

    ' Move selection two columns to the right
    ActiveCell.Offset(0, 2).Select

    ' This loop repeats the formula on every single row adjacent to a value
    For lngCounter = 1 To lngLastRowContainingData - 1
        ' Here is the formula, change all instances of Range("F2") to the cell in which you want to store the weight
        ActiveCell.Value = (ActiveCell.Offset(0, -2).Value * Range("F2")) + (ActiveCell.Offset(0, -1).Value * Range("F2"))
        ActiveCell.Offset(1, 0).Select
    Next

    ' Go to A1, scroll to it
    Range("A1").Select
    Application.Goto ActiveCell, True

    ' Autofit columns
    Columns.EntireColumn.AutoFit

    ' Allowing screen updates again
    Application.ScreenUpdating = True


    On Error GoTo 0
    Exit Sub

    ' Error handler
MistHandler:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure WeightedSumDynamicWeights of basMain", vbExclamation, " vicsar says"

End Sub

VBA中的加权和

2 个答案: