excel - VBA从多个工作表文件中的变量范围中提取值

Question

数据样本

我仍在学习 VBA，并且我知道在 stackoverflow 上提出问题的主要挑战在于目标和思考过程要清楚。让我们看看我能不能把重点说清楚。

我面临具有多个工作表的文件，这些工作表具有以下特点：

• 时间序列数据没有固定的范围，它们可能以行中的行项目和列中的年份来组织，反之亦然。
• 对于不同文件中的同一项目，每个时间序列可能具有不同的名称（例如，Revenues、Rev、XYZ Reven 等）。

我想创建一个工具，让用户选择特定的时间序列并将数据存储在集合或数组中，以便在新工作簿中进行计算（比如时间序列的平均值）。

我尝试的第一种方法是改编我从 J.Walkenbackh 找到的关于映射文件的代码（https://www.dummies.com/software/microsoft-office/excel/using-vba-to-create-a- worksheet-map/），但我还没有找到一个明确的策略来处理由于源文件格式不佳而可能也属于数字数据的文本单元格。下面是我获取文本文件单元格的部分尝试。

我想我对我应该在这里采取的方法感到困惑，而且我也让尝试使用类来映射时间序列和标准名称的事情变得复杂。

希望我能清楚地表达我的观点，并感谢您的帮助。谢谢！

    Sub QuickMap()
  Dim FormulaCells As Variant
  Dim TextCells As Variant
  Dim NumberCells As Variant
  Dim Area As Range
  Dim cel As Range
  Dim coll As New Collection

  If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
'  Create object variables for cell subsets
  On Error Resume Next
  Set FormulaCells = Range("A1").SpecialCells(xlFormulas, xlNumbers + xlTextValues + xlLogical)
  Set TextCells = Range("A1").SpecialCells(xlConstants, xlTextValues)
  Set NumberCells = Range("A1").SpecialCells(xlConstants, xlNumbers)
  On Error GoTo 0

'  Add a new sheet and format it
  Sheets.Add
  With Cells
    .ColumnWidth = 2
    .Font.Size = 8
    .HorizontalAlignment = xlCenter
  End With
  Application.ScreenUpdating = False

'  Do the formula cells
  If Not IsEmpty(FormulaCells) Then
    For Each Area In FormulaCells.Areas
      With ActiveSheet.Range(Area.Address)
        .Value = "F"
        .Interior.ColorIndex = 3
      End With
    Next Area
  End If

'  Do the text cells
  If Not IsEmpty(TextCells) Then
    For Each Area In TextCells.Areas
      With ActiveSheet.Range(Area.Address)
        .Value = "T"
        .Interior.ColorIndex = 4
      End With
    Next Area
  End If

'  Do the numeric cells
  If Not IsEmpty(NumberCells) Then
    For Each Area In NumberCells.Areas
      With ActiveSheet.Range(Area.Address)
        .Value = "N"
        .Interior.ColorIndex = 6
      End With
    Next Area
  End If

  'Check if range is vertical(?)

  'Loop through each cell of the area
   For Each Area In TextCells.Areas
    For Each cel In Area
        If cel.Value <> vbNullString Then
             coll.Add cel.Value, cel.Address
        End If
    Next cel
   Next Area

b_frmSelect.List1.list = coll
b_frmSelect.Show

标签： excelvbarangeuserform