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

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

0 个答案: