【问题标题】:Manipulating variables with excel用excel处理变量
【发布时间】:2016-07-31 09:20:20
【问题描述】:

语言:Excel

您好,感谢您阅读我的帖子。

我正在尝试创建一个公式来...根据变量乘以单元格(或在本例中为字母)。变量是它是否能被(1000 + 250x)整除,根据答案,乘以相应的字母百分比。

视觉表现:

   A     B     C   
   1%    2%    3%  
   250   500   1000  


1  1,000
2  1,250
3  1,500
4  1,750
5  2,000 

例如,因为 #1 可以被 1000 整除,所以我将它乘以 3% 第二个例子,因为 #2 可以被 250 和 1000 整除,所以我会将 250 乘以 1%,将 1000 乘以 3%,然后将它们相加。

我目前的尝试:

=IF(MOD(A2,F14)<=1,A2*F15,"")

A2 = 起始金额 F14 = A2 除以什么
F15 = 百分比

这种方法可行,但它无法让我找到最佳解决方案

非常感谢您在我的困境中提供的帮助。

【问题讨论】:

  • 麻雀先生,请通过编辑改进您的帖子
  • “最佳解决方案”是什么意思?
  • 我的意思是 最好的解决方案 @user3598756 ...例如,以数字 3 为例。将 500(来自 1500)的总数除以 2,然后乘以 1%,或者换句话说,取 (((250 * 1%)*2)+(1000*3) 并不理想%)), INSTEAD, 这样做会更理想... ((500*2%) + (1000*3%))

标签: excel vba loops


【解决方案1】:

在 Sparrow 解释之后,我得到“最佳可能解决方案”是通过将所有可能的整数除数(即 250、500、1000)乘以它们对应的“奖品”(1%, 2%、3%)

这是一个后续解决方案

Option Explicit

Sub main()
Dim dataRng As Range, cell As Range, percRng As Range, divRng As Range
Dim i As Long, value As Long, nDivisors As Long
Dim prize As Double, totalPrize As Double

Set dataRng = ActiveSheet.Range("B1:B10") '<== here set the range cointaining the numbers to be processed
Set percRng = ActiveSheet.Range("F15:H15") '<== here set the range of % "prizes": they MUST be in ascending order (from lowest to highest)
Set divRng = ActiveSheet.Range("F14:H14") '<== here set the range of the possible divisors. this range MUST be of the same size as thre "prizes" range

For Each cell In dataRng.SpecialCells(xlCellTypeConstants, xlNumbers)

    value = cell.value
    nDivisors = 0
    prize = 0
    totalPrize = 0
    Do
        i = FindMaxDivisor(value, percRng, divRng)
        If i > 0 Then
            value = value - divRng(i) ' update value to the remainder
            prize = percRng(i) * divRng(i) ' get current "prize"
            totalPrize = totalPrize + prize 'update totalprize
            nDivisors = nDivisors + 1 'update divisors number
            cell.Offset(, nDivisors) = divRng(i)  'write divisor in next blank adjacent cell in the number row
        End If
    Loop While value > 0 And i >= 0

    If i >= 0 Then ' the number has been correctly divided by given divisors
        With cell.Offset(, nDivisors + 1)
            .value = totalPrize
            .Font.Color = vbRed
        End With
    Else
        MsgBox "Not possible to break " & cell.value & " into given divisors"
    End If

Next cell

End Sub


Function FindMaxDivisor(value As Long, percRng As Range, divRng As Range) As Long
Dim i As Long

FindMaxDivisor = -1 'default value should not be found any whole divisor

i = divRng.Columns.Count
Do While value Mod divRng(i) <> 0 And i > 1
    i = i - 1
Loop

If value Mod divRng(i) = 0 Then FindMaxDivisor = i

End Function

每个数字的“最佳”除数将写在数字旁边的列中,最后一个数字中的“总奖金”会用红色写出

【讨论】:

    【解决方案2】:

    对于 Excel 公式,我想不出任何好的解决方案,因为您想要的结果太复杂:就像您标记了您的问题一样,无论如何您都需要一个循环,恐怕哪些公式不能为您做。
    但是,当您将 VBA 添加为标签之一时,我认为 VBA 解决方案对您有用,所以这是我编写的脚本:

    Option Explicit 'variables MUST BE declared, otherwise error. very handy rule
    Option Base 0 'won't be needed this time, but in general, this rule is also a great ally
    '(it says: arrays' 1st item will always be the "0th" one)
    Dim divLARGE, divMED, divSMALL 'you can use variable types in Excel Dim percLARGE, percMED, percSMALL 'but sadly, not in VBScript which I have ATM

    'test input values and their results, won't be needed in your Excel Dim testA, testB, testC, testD, testE, testF 'so add types if you like Dim resA, resB, resC, resD, resE, resF '(should make execution a little faster)

    'Init our variables declared above. in VBScript you can't do this at declaration,
    'i.e. can't say "Dim whatever As Boolean = true" which would be the right way to do this Call Initialize()

    'Call the "main routine" to execute code
    Call Main()

    'you can add access modifiers here. "private" would be the best
    'i.e. "private Sub Main()" Sub Main() resA = CalcMaster(testA, divLARGE) resB = CalcMaster(testB, divLARGE) resC = CalcMaster(testC, divLARGE) resD = CalcMaster(testD, divLARGE) resE = CalcMaster(testE, divLARGE) resF = CalcMaster(testF, divLARGE) MsgBox (CStr(testA) + " --> " + CStr(resA) + vbCrLf + _ CStr(testB) + " --> " + CStr(resB) + vbCrLf + _ CStr(testC) + " --> " + CStr(resC) + vbCrLf + _ CStr(testD) + " --> " + CStr(resD) + vbCrLf + _ CStr(testE) + " --> " + CStr(resE) + vbCrLf + _ CStr(testF) + " --> " + CStr(resF) + vbCrLf) End Sub
    Sub Initialize() divLARGE = 1000 'the large number for which we look after remnants divMED = 500 'medium/middle sized number to divide by divSMALL = 250 'the small value percLARGE = 3 'percentage we want if no remnants on LARGE number percMED = 2 'same but for medium/mid size numbers percSMALL = 1 'and the percentage we want for the small remnants
    testA=1000 'result should be exactly 30.0 testB=1250 'res == 32.5 testC=1500 'res == 40.0 testD=1750 'res == 42.5 testE=2000 'res == 60.0 testF=-198 'res == #ERROR/INVALID VALUE End Sub
    Function CalcMaster(inVar, byDiv) 'A silly function name popped in my mind, sorry :) Dim remnant, percDiv
    'sometimes happens, looks cheaper calc.wise to handle like this; if initial input
    'can be 0 and that's a problem/error case, handle this scenario some other way If (inVar = 0) Then Exit Function remnant = inVar Mod byDiv 'if you'll implement more options, do a Select...Case instead (faster) If (byDiv = divLARGE) Then percDiv = percLARGE ElseIf (byDiv = divMED) Then percDiv = percMED Else percDiv = percSMALL End If

    If (remnant = 0) Then CalcMaster = inVar * (percDiv / 100) Exit Function End If 'had remnant; for more than 3 options I would use an array of options 'and call back self with the next array ID If (byDiv = divLARGE) Then CalcMaster = CalcMaster(inVar - remnant, divLARGE) + CalcMaster(remnant, divMED) ElseIf (byDiv = divMED) Then CalcMaster = CalcMaster(inVar - remnant, divMED) + CalcMaster(remnant, divSMALL) Else 'or return 0, or raise error and handle somewhere else, etc 'MsgBox ("wrong input number: " + CStr(inVar)) CalcMaster = -1 End If End Function


    这并不完美,我认为那里可能有更好的解决方案,但我认为这对事业来说已经足够了。我希望你同意 :)
    干杯

    【讨论】:

    • 我已将 VBA 标记为可能的解决方案,尽管我缺乏该领域的经验。我相信由于您的注释和我之前的编码经验,我将能够相当快地掌握它。既然您花时间为我编写了代码,我将花时间剖析并学习它来回报您的好意。非常感谢马克!
    • @Sparrow 不客气!如果您有任何问题,请不要犹豫。提前感谢您将我的答案标记为解决方案,如果您能够将它与您的实际 Excel 放在一起并解决问题;)
    猜你喜欢
    • 2021-07-03
    • 2016-01-16
    • 2015-07-25
    • 1970-01-01
    • 2016-07-16
    • 1970-01-01
    • 2021-03-12
    • 2011-07-07
    • 1970-01-01
    相关资源
    最近更新 更多