Question

我有一些代码可以做到这一点。但我想自定义这段代码是针对我的情况的。目前的代码：

Sub Finalone()
Dim lastrow As Long, r1 As Long
Dim temp As String, arTemp
Dim temp2 As String
Dim temp3 As String

temp3 = ""

    ' Get the last row in the worksheet
lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

For r1 = 1 To lastrow

    ' If A & B aren't blank, make the formula of cell C equal to A + B.
    If ActiveSheet.Range("$C$" & r1).Value <> "" And Mid(ActiveSheet.Range("$C$" & r1).Formula, 1, 1) = "=" Then
        If Asc(Mid(ActiveSheet.Range("$C$" & r1).Formula, 2, 1)) >= 65 And Asc(Mid(ActiveSheet.Range("$C$" & r1).Formula, 2, 1)) <= 90 Then
            ' Get the formula for the current C cell
            temp = Replace(ActiveSheet.Range("$C$" & r1).Formula, "=", "")

            ' Create an array by splitting the formula on the + sign
            arTemp = Split(temp, "+")

            temp2 = ActiveSheet.Range(arTemp(0)).Value

            For i = 1 To UBound(arTemp)
                temp3 = ActiveSheet.Range(arTemp(i)).Value

                temp2 = temp2 & "+" & temp3

            Next i

            ActiveSheet.Range("$C$" & r1).Value = "=" & temp2
        End If

    End If

Next

End Sub

以上代码仅适用于如果A和B列具有值且C列具有公式且公式为A + B. 但我的意思是 - 值列可能是varry。公式列不是C，我的情况的公式用例是（R12-Q12）/ 2。我需要一个宏来获取用户的输入，就像用户必须选择要将上述公式转换为值的列一样。

Answer 1

Excel不支持以简单方式对单元格/数字/运算符进行逻辑解析。我喜欢一点挑战，所以我已经敲了一些东西。

以下内容适用于在同一张纸上使用4个标准运算符，括号，数字和单元格引用解析和重新组合简单公式。

Sub FinalOne()

Dim rng As Range, rngPrecedents As Range, rngPrecedent As Range
Dim i As Integer, j As Integer, x As Integer, b As Integer, rCount As Long
Dim tmp As String
Dim ws1 As Worksheet, ws2 As Worksheet

'FIRST WE SET SOME VARIABLES FOR OUR ACTIVESHEET AND A TEMP SHEET TO HOLD THE PARSED FORMULAE
Set ws1 = ActiveSheet
Set ws2 = Sheets.Add
ws1.Activate
rCount = 1

'WE SET THE RANGE BASED ON USER SELECTION
Set rng = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)

'THEN WE ITERATE THROUGH EACH CELL
    For Each c In rng
        x = 1
        i = 0
        'AND THROUGH EACH CHARACTER ALONG THE LENGTH OF THE FORMULA
        For j = 1 To Len(c.Formula)
            Select Case Mid(c.Formula, j, 1)
                'WE CHECK IF THE GIVEN CHARACTER IS AN OPERATOR
                Case "=", "+", "-", "/", "*", "(", ")"
                    ws2.Range("A" & rCount).Offset(0, i).Value = Mid(c.Formula, j, 1)
                    i = i + 1
                'WE CHECK IF THE GIVEN CHARACTER IS A NUMERIC VALUE
                Case 0 To 9
                    ws2.Range("A" & rCount).Offset(0, i).Value = Mid(c.Formula, j, 1)
                    i = i + 1
                'OR WE ASSUME THAT IT'S A CELL REFERENCE
                Case Else
                    Set rngPrecedents = c.Precedents
                    Set rngPrecedent = rngPrecedents(x)
                    ws2.Range("A" & rCount).Offset(0, i).Value = rngPrecedent.Value
                    i = i + 1
                    j = j + Len(rngPrecedent.Address) - 3
                    x = x + 1
            End Select
        Next j
        rCount = rCount + 1
    Next c

'AFTER WE'VE PARSED THE CELL CONTENTS INTO DIFFERENT CELLS ON OUR TEMP SHEET
'WE RE-COMBINE THEM IN A TEMP COLUMN ON OUR WORKING SHEET

rng.Offset(0, 1).EntireColumn.Insert

rCount = 1
i = 0

    For Each c In rng
        For i = 0 To ws2.Cells(rCount, ws2.Columns.Count).End(xlToLeft).Column
            tmp = tmp + ws2.Range("A" & rCount).Offset(0, i).Text
        Next i
        c.Offset(0, 1).Value = tmp
        tmp = ""
        rCount = rCount + 1
    Next c

'NOW WE TIDY UP

rng.Formula = rng.Offset(0, 1).Formula
rng.Offset(0, 1).EntireColumn.Delete

Application.DisplayAlerts = False
ws2.Delete
Application.DisplayAlerts = True

End Sub

如果您的参考文件不在表格中，您可能会感到困惑，因为先例方法仅适用于同一张纸上的参考。

如何在单元格公式中显示值而不是引用

1 个答案: