Question

我需要对一组值求和并得到另一个值，这组值可以变化（意味着它可以包含4或20个值），但我只需要一个使用这些值而不修改任何值的组合并达到正确的最终价值。

示例：

Amounts:
435.97
40180.6
261.19
14861.68
108.7
77.97
316.02
1345.4
1255.96
10851.02
3517.04

使用上述金额组合达到的价值：57050.23

This topic显示了如何在多种语言中执行非常相似的操作，但我需要在PowerShell中或在Excel中执行此操作的公式。

Answer 1

我们设法通过PowerShell调用Excel宏，它正在运行。这是一个相当广泛的代码（815行），但这里是我们称之为vba宏的部分，并将结果放在向量上以过滤与我们想要达到的值匹配的值（在本例中为orders）：

$WorksheetAutomation12.Activate()
$ExcelAutomation.Run("Descobrir")

$WorksheetAutomation12.Columns.Item('D').NumberFormat = "0"

$AuxMacro = $CNPJCount+5

$FilterOrdersMacro = @()

for($i=6;$i -le $AuxMacro;$i++)
{
    $MacroValue = $WorksheetAutomation12.Cells.Item($i, 4).value()
    if(($MacroValue -ne 0) -and ($MacroValue -ne $null))
    {
        $FilterOrdersMacro += , "$MacroValue"
    }
}

$FilterOrdersMacro

和VBA宏：

Option Explicit

Dim dv() As Double
Dim dvTeste() As String

Dim dMeta As Double

Dim e As Long
Dim eTeste As Long

Dim blAchou As Boolean

Dim vOrigem()
Dim vOrigemTeste()

Dim rLast As Long
Dim blParar
Dim dDiferença As Double

Sub Descobrir()

        With ThisWorkbook.Sheets("Macro")
            'rLast is the last used row:
            rLast = .Cells(.Rows.Count, "A").End(xlUp).Row

            'Put column A into a vector:
            vOrigem = Application.Transpose(.Range("A1:A" & rLast))
            vOrigemTeste = Application.Transpose(.Range("B1:B" & rLast))


            '"Meta" is the value we want to reach
            dMeta = .Range("C2")

            .Range("C5:C" & rLast + 4).ClearContents
            .Range("E2:F2").ClearContents
            .Range("E4") = "Executing . . ."

            Recursar

            .Range("E4").ClearContents

            'Throw the solution on the worksheet
            If blAchou Then
'                DisporResultado

            Else
                If blParar Then

                Else

                End If
            End If
        End With

End Sub

Sub DisporResultado()
    With ThisWorkbook.Sheets("Macro")
        Dim n As Long
        Dim nTeste As Long

        .Range("C5:C" & rLast + 5).ClearContents
        .Range("D5:D" & rLast + 5).ClearContents
        .Range("E2") = Soma(dv)

        .Range("F2") = dDiferença

        For n = 1 To UBound(dv)
            .Cells(n + 5, "C") = dv(n)
        Next n

        For nTeste = 1 To UBound(dvTeste)
            .Cells(nTeste + 5, "D") = dvTeste(nTeste) '
        Next nTeste


    End With
End Sub

Function Recursar(Optional r0 As Long)

    Dim r As Long
    Dim n As Long

    Dim rTeste As Long
    Dim nTeste As Long

    Dim dSoma As Double

   If r0 = 0 Then

        e = 0
        eTeste = 0

        r0 = 1
        blAchou = False
        blParar = False

        dDiferença = 1.79769313486231E+308
    End If

    DoEvents

    For r = r0 To rLast
        e = e + 1
        eTeste = eTeste + 1

        ReDim Preserve dv(1 To e)
        ReDim Preserve dvTeste(1 To eTeste)

        dv(e) = vOrigem(r)
        dvTeste(eTeste) = vOrigemTeste(r)

        If Abs(dSoma - dMeta) < Abs(dDiferença) Then
            dDiferença = dSoma - dMeta
            DisporResultado
        End If
        Select Case dSoma
            Case Is < dMeta
                If r = rLast Then
                    e = e - 2
                    eTeste = eTeste - 2
                    If e > 0 Then
                        ReDim Preserve dv(1 To e)
                        ReDim Preserve dvTeste(1 To eTeste)
                    End If
                Else
                    Recursar r + 1
                End If
            Case Is > dMeta
                e = e - 1
                eTeste = eTeste - 1
                If e > 0 Then
                    ReDim Preserve dv(1 To e)
                    ReDim Preserve dvTeste(1 To eTeste)
                End If
                If r = rLast Then
                    e = e - 1
                    eTeste = eTeste - 1
                    If e > 0 Then
                        ReDim Preserve dv(1 To e)
                        ReDim Preserve dvTeste(1 To eTeste)
                    End If
                End If
            Case dMeta
                blAchou = True
        End Select
        If blAchou found Or blParar Then Exit Function
    Next r

End Function

Function Soma(v As Variant) As Double

    Dim n As Long
    Dim dSoma As Double
    For n = 1 To UBound(v)
        dSoma = dSoma + v(n)
    Next n
    Soma = dSoma
End Function

Sub Parar()
    blParar = True
End Sub

字幕：Parar =停止。索玛=总和。 Achou =找到的值。
谢谢你的帮助:)

求和给定的值并达到另一个值

1 个答案: