Question

I have a data table of volumes and total concentration. I want to input a value into a cell, and loop through the data table and output the total volume needed from the data table to calculate my new mixture.

Example data table:

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

If this is my data, and I want to make a new batch that is 8000 volume and 700,000 for concentration, how can I calculate which sample numbers to mix and in what volumes to get the new concentration and volume.

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事件之后，结果将填入“待混合”列和“实际量”单元格中。工作表上的任何更改都会立即显示结果：

如果有任何零浓度样品，则首先使用它：

Calculating desired value based on data table

1 个答案: