提取值以适合更改方程

Question

不确定如何处理这种情况。最好的解释可能是视觉上的，以下是我手头上的稀释状况：

表1：

Column A    Column B
Chocolate   20
Vanilla     10
Strawberry  30

表2：

Column A                            
Chocolate + Vanilla
Vanilla / Strawberry
Chocolate / (Strawberry + Vanilla) 

目标：

表2：

Column A                             Column B
Chocolate + Vanilla                  30
Vanilla / Strawberry                 1/3
Chocolate / (Strawberry + Vanilla)   1/2

我遇到的麻烦是，我可以做一个索引/匹配或vlookup方法，并单独拉动与风味(巧克力，香草，草莓(相对应的数字 - 但是有没有办法让Excel知道什么算术功能基于第2页，列a列，而不是手动调整每一行以适合正确的公式？

本质上，某种函数或VBA方法会告诉Excel：" Grab＆amp;了解该行中的算术符号/方程并遵循该命令"，因此我不必将每一行调整为正确的数学象征？

Answer 1

如果您的公式不断坚持Excel UI公式输入规则，那么您可以尝试一下

Sub Main()
    Dim cell As Range
    Dim strng As String
    Dim element As Variant
    Dim elementValue As Variant
    With Worksheets("Sheet2")
        For Each cell In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
            strng = cell.Value2
            For Each element In Split(Replace(Replace(cell.Value2, "(", ""), ")", ""))
                If GetValue(CStr(element), elementValue) Then strng = Replace(strng, element, elementValue)
            Next
            cell.Offset(, 1).Formula = Replace("=" & strng, " ", "")
        Next
    End With
End Sub
Function GetValue(elementName As String, elementValue As Variant) As Boolean
    Dim f As Range
    With Worksheets("Sheet1")
        Set f = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Find(what:=elementName, lookat:=xlWhole, LookIn:=xlValues)
        If Not f Is Nothing Then
            elementValue = f.Offset(, 1)
            GetValue = True
        End If
    End With
End Function

Answer 2

基本上我们可以使用 RegEx识别'名称'，然后获取'名称'的值的地址。然后，我们可以在Sheet2中得出一个公式。

Sub Test()
Set mysheet2 = ThisWorkbook.Worksheets("Sheet2")
Set regEx = New RegExp
regEx.Pattern = "w+"
regEx.Global = True
For i = 1 To mysheet2.UsedRange.Rows.Count
    formula_str = mysheet2.Cells(i, 1).Value
    Set oMatches = regEx.Execute(formula_str)
    For Each oMatch In oMatches
        formula_str = Replace(formula_str, oMatch, getAdd(oMatch))
    Next
    mysheet2.Cells(i, 2) = "=" & formula_str
Next
End Sub
'Function to get the address of 'names'
Function getAdd(keyword)
    Set mysheet1 = ThisWorkbook.Worksheets("Sheet1")
    getAdd = ""
    With mysheet1
        For i = 1 To .UsedRange.Rows.Count
            If .Cells(i, 1) = keyword Then
                getAdd = mysheet1.Name & "!" & .Cells(i, 2).Address
                Exit For
            End If
        Next
    End With
End Function

当前该解决方案的限制是所有"名称"必须是字母格式。如果要使用包含数字和其他字符的名称，则应更改RegEx模式。