正在根据数据计算期望值 table

Question

我有体积和总浓度的数据 table。我想将一个值输入到一个单元格中，循环遍历数据 table 并从数据 table 中输出所需的总体积来计算我的新混合物。

示例数据table:

sample #    Volume  concentration
1            4000.0    250000
2            4000.0    300000
3            4000.0    650000
4            4000.0    2000000

如果这是我的数据，我想制作一个 8000 体积和 700,000 浓度的新批次，我如何计算要混合的样本数量以及获得新浓度和体积的体积。

Answer 1

我假设公式应该如下：

考虑使用以下 VBA 代码实现的算法，将代码放在 Sheet1 模块中：

Option Explicit

Private Type Solution
    Volume As Variant
    Initial As Variant
    Conc As Variant
End Type

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Samples() As Solution
    Dim ConcTarget As Double
    Dim ConcMin As Double
    Dim ConcMax As Double
    Dim ConcDelta As Double
    Dim ConcDelta1 As Double
    Dim ConcDelta2 As Double
    Dim VolumeTarget As Double
    Dim VolumeTotal As Double
    Dim VolumeMix As Double
    Dim Volume1 As Double
    Dim Volume2 As Double
    Dim Sample1 As Long
    Dim Sample2 As Long
    Dim Sample1Found As Boolean
    Dim Sample2Found As Boolean
    Dim i As Long

    Application.EnableEvents = False

    ' retrieve initial data and targets from the sheet and clear results
    i = 2
    With Sheets("Sheet1")
        Do While .Cells(i, 1) <> ""
            ReDim Preserve Samples(i - 2)
            Samples(i - 2).Volume = .Cells(i, 2).Value
            Samples(i - 2).Initial = Samples(i - 2).Volume
            Samples(i - 2).Conc = .Cells(i, 3).Value
            .Cells(i, 4).Value = ""
            i = i + 1
        Loop
        ConcTarget = .Cells(2, 7).Value
        VolumeTarget = .Cells(2, 6).Value
    End With

    VolumeTotal = 0
    ' begin of iterations
    Do

        ' min and max concentration available
        ConcMax = 0
        ConcMin = 1.7976931348623E+308
        For i = 0 To UBound(Samples)
            If Samples(i).Conc < ConcMin And Samples(i).Volume > 0 Then
                ConcMin = Samples(i).Conc
                Sample1 = i ' lowest concentration sample
            End If
            If Samples(i).Conc > ConcMax And Samples(i).Volume > 0 Then
                ConcMax = Samples(i).Conc
                Sample2 = i ' highest concentration sample
            End If
        Next

        If ConcMin > 0 Then
            ' zero concentration sample isn't available
            ' choose appropriate samples available to mix
            Sample1Found = False
            Sample2Found = False
            For i = UBound(Samples) To 0 Step -1
                If Samples(i).Volume > 0 Then
                    Select Case True
                        Case Samples(i).Conc <= ConcTarget And Samples(i).Conc >= Samples(Sample1).Conc
                            ' closest less concentrate sample
                            Sample1 = i
                            Sample1Found = True
                        Case Samples(i).Conc >= ConcTarget And Samples(i).Conc <= Samples(Sample2).Conc
                            ' closest more concentrate sample
                            Sample2 = i
                            Sample2Found = True
                    End Select
                End If
            Next

            ' check if necessary samples are available
            If Not (Sample1Found And Sample2Found) Then
                Exit Do
            End If
        End If

        ' calculate delta for chosen samples
        ConcDelta = Samples(Sample2).Conc - Samples(Sample1).Conc
        ConcDelta1 = ConcTarget - Samples(Sample1).Conc
        ConcDelta2 = Samples(Sample2).Conc - ConcTarget

        ' calculate volumes
        Volume1 = (VolumeTarget - VolumeTotal) * ConcDelta2 / ConcDelta
        Volume2 = (VolumeTarget - VolumeTotal) * ConcDelta1 / ConcDelta
        VolumeMix = Volume1 + Volume2

        ' check if volumes are enough and reduce to available volume
        Select Case True
            Case Volume1 > Samples(Sample1).Volume ' sample 1 not enough
                Volume1 = Samples(Sample1).Volume
                VolumeMix = Volume1 * ConcDelta / ConcDelta2
                Volume2 = VolumeMix * ConcDelta1 / ConcDelta
                If Volume2 > Samples(Sample2).Volume Then ' sample 2 not enough
                    Volume2 = Samples(Sample2).Volume
                    VolumeMix = Volume2 * ConcDelta / ConcDelta1
                    Volume1 = VolumeMix * ConcDelta2 / ConcDelta
                End If
            Case Volume2 > Samples(Sample2).Volume ' sample 2 not enough
                Volume2 = Samples(Sample2).Volume
                VolumeMix = Volume2 * ConcDelta / ConcDelta1
                Volume1 = VolumeMix * ConcDelta2 / ConcDelta
                If Volume1 > Samples(Sample1).Volume Then ' sample 1 not enough
                    Volume1 = Samples(Sample1).Volume
                    VolumeMix = Volume1 * ConcDelta / ConcDelta2
                    Volume2 = VolumeMix * ConcDelta1 / ConcDelta
                End If
        End Select

        ' change available volumes
        Samples(Sample1).Volume = Samples(Sample1).Volume - Volume1
        Samples(Sample2).Volume = Samples(Sample2).Volume - Volume2

        ' check if target volume has been mixed
        VolumeTotal = VolumeTotal + VolumeMix
        If VolumeTotal = VolumeTarget Then Exit Do

    Loop

    ' results output
    With Sheets("Sheet1")
        For i = 0 To UBound(Samples)
            .Cells(i + 2, 4).Value = Samples(i).Initial - Samples(i).Volume
        Next
        .Cells(2, 5).Value = VolumeTotal
    End With

    Application.EnableEvents = True

End Sub

我使用源数据填充 Sheet1：

之后 Worksheet_Change 事件被触发，结果填充在 "To be mixed" 列和 "Actual volume" 单元格中。 sheet 的任何更改都会立即给出结果：

如果有任何零浓度样品可用，那么将首先使用它：

正在根据数据计算期望值 table

Calculating desired value based on data table

excel

vba

scientific-computing