使用VBA在Excel中查看公式框中的单元格内容而非公式

Question

我正在基于我的活动表格中的第一行（1）和第一列（A），从名为 Shop 的表格中查找销售额sales的值，如下所示：

我正在使用以下可用的代码：

lastRow = Range("A1").End(xlDown).Row
lastColumn = Range("A1").End(xlRight).Column

'i -> rows
For i = 2 to lastRow
   
   shopName = Cells(i, 1).Value

   'j -> cols
   For j = 2 to lastColumn

      shopRegion = Cells(1, j).Value
      
      Cells(i,j).FormulaArray = "=Index(Shop[Sales], Match(1, (RC[" & (1- j) & "] = Shop[Name])*(R[" & (1- i) & "]C = Shop[Region]), 0))"

   Next j
Next i

我看到正确的值填充在单元格中。

1. 我想在Excel中的公式框中看到单元格内容而非公式。我尝试了 Application.Evaluate，但没有成功。

2. (不重要) 是否有办法在 Cells(i,j).FormulaArray 中使用变量 shopName 和 shopRegion 而不是相对引用 RC？

- M J

Answer 1

一种VBA查找方法：在Excel表格中查找表头

• 评估在任何情况下都无法与这种类型的公式一起使用。

• 编写公式后，可以复制/粘贴值，例如：

  Dim rg As Range: Set rg = Range("A1").CurrentRegion
  rg.Value = rg.Value
  

  这也会复制标题，但它们不会产生影响。

• 如果您想更准确地排除标题(Shops和Regions)，请使用：

  With rg.Resize(rg.Rows.Count - 1, rg.Columns.Count - 1).Offset(1, 1)
      .Value = .Value
  End With
  

Sub UpdateData()
    
    ' Constants
    Const SRC_SHEET As String = "Sheet1"
    Const SRC_TABLE As String = "Shop"
    Const SRC_ROWS As String = "Name"
    Const SRC_COLUMNS As String = "Region"
    Const SRC_VALUES As String = "Sales"
    Const DST_SHEET As String = "Sheet1"

    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook  ' workbook containing this code
    
    ' Source to Arrays
    
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
    Dim slo As ListObject: Set slo = sws.ListObjects(SRC_TABLE)
    Dim srCount As Long: srCount = slo.DataBodyRange.Rows.Count
        
    Dim srData(): srData = slo.ListColumns(SRC_ROWS).DataBodyRange
    Dim scData(): scData = slo.ListColumns(SRC_COLUMNS).DataBodyRange
    Dim svData(): svData = slo.ListColumns(SRC_VALUES).DataBodyRange

    ' Destination to Dictionaries

    Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
    Dim drg As Range: Set drg = dws.Range("A1").CurrentRegion
    
    ' Names
    Dim drCount As Long: drCount = drg.Rows.Count - 1
    Dim drData(): drData = drg.Resize(drCount, 1).Offset(1).Value
    Dim rDict As Object: Set rDict = CreateObject("Scripting.Dictionary")
    rDict.CompareMode = vbTextCompare
    Dim dr As Long
    For dr = 1 To UBound(drData, 1)
        rDict(drData(dr, 1)) = dr
    Next dr
    Erase drData
    
    ' Region
    Dim dcCount As Long: dcCount = drg.Columns.Count - 1
    Dim dcData(): dcData = drg.Resize(1, dcCount).Offset(, 1).Value
    Dim cDict As Object: Set cDict = CreateObject("Scripting.Dictionary")
    cDict.CompareMode = vbTextCompare
    Dim dc As Long
    For dc = 1 To UBound(dcData, 2)
        cDict(dcData(1, dc)) = dc
    Next dc
    Erase dcData
    
    ' Values
    Dim dvData(): ReDim dvData(1 To drCount, 1 To dcCount)
    
    ' Dictionary to Destination Values Array
    
    Dim sr As Long
    
    For sr = 1 To srCount
        If rDict.Exists(srData(sr, 1)) Then
            If cDict.Exists(scData(sr, 1)) Then
                dvData(rDict(srData(sr, 1)), cDict(scData(sr, 1))) _
                    = svData(sr, 1)
            End If
        End If
    Next sr
    
    ' Destination Values Array to Destination Range
   
    With drg.Resize(drCount, dcCount).Offset(1, 1)
        .ClearContents
        .Value = dvData
    End With

    ' Inform.
    MsgBox "Data updated.", vbInformation

End Sub

- VBasic2008