Question

我的总体目标是获取原始电子表格中三个不同列的值和行索引，对其进行评估，然后将它们保存到新的电子表格中。我希望通过使用原始电子表格上的按钮启动的宏来实现此目的。

实现这一目标的计划是

为每列创建一个范围
循环通过最重要的范围来抓取并评估每个单元格值
在第一个循环中执行嵌套循环，以进一步评估其他两个范围并获取其值
为变量赋值
从模板
将值写入相应的列
保存新电子表格

当我运行下面的代码时，我得到下面列出的错误。我很困惑，因为我认为这是你引用整个专栏的方式：

Sub Transfer2NewWorkbook()
  Dim currentsheet As String
  Dim newsheet As String
  Dim analysisDate As String
  Dim initial As String
  Dim aInitial() As String
  Dim analystInit As String
  Dim batchNo As String

  Dim wb As Object
  Dim dataRangeA As Range, dataRangeB As Range, dataRangeI As Range
  Set dataA = CreateObject("Scripting.Dictionary")


  ' Grab and Create filenames
  currentsheet = ActiveWorkbook.Name
  newsheet = currentsheet & "-" & "uploadable"

  ' Grab data from original spreadsheet
  analysisDate = ActiveWorkbook.Sheets(1).Cells(1, 9).Value

  initial = ActiveWorkbook.Sheets(1).Cells(1, 2).Value
  aInitial = Split(initial, "/")
  analystInit = aInitial(1)

  Set dataRangeA = Range("A4:A").Select ' <-- Line causing error
  Set dataRangeB = Range("B4:B").Select
  Set dataRangeI = Range("I4:I").Select

  For i = 1 To dataRangeA.Rows.Count
    dataA.Add Key:=i, Item:=dataRangeA.Cells.Value
  Next i

  Set wb = Workbooks.Add("C:\Users\dalythe\documents\uploadtemp.xlsx")

  ActiveWorkbook.Sheets(1).Cells(3, 2).Value = analysisDate
  ActiveWorkbook.Sheets(1).Cells(3, 4).Value = analystInit


  ActiveWorkbook.SaveAs (newsheet & ".xlsx")


End Sub

Answer 1

试试这个：

Set dataRangeA = Range("A:A").Select
Set dataRangeB = Range("B:B").Select
Set dataRangeI = Range("I:I").Select

For i = 4 To dataRangeA.Rows.Count
    dataA.Add Key:=i, Item:=dataRangeA.Cells.Value
Next i

Answer 2

删除.Select后，我的范围被接受了。

Set dataRangeA = Range("A:A")
Set dataRangeB = Range("B:B")
Set dataRangeI = Range("I:I")

For i = 4 To dataRangeA.Rows.Count
   dataA.Add Key:=i, Item:=dataRangeA.Cells.Value
Next i

感谢输入 YowE3k 。现在我必须考虑我希望循环结束的方式。因为按照我上面的方式进行操作会导致内存不足。电子表格不会有“预定义”的行数。我想我必须让用户在最后一行的单元格中输入“End”。

Answer 3

抛出错误的特定行的问题是由两件事引起的：

"A4:A"不是Excel中的有效地址。您可以将"A:A"用于整个列，也可以定义范围的结尾，例如： "A4:A272"。
Range.Select方法不会返回对象，因此Set dataRangeA = Range("A4:A").Select实际上是Set dataRangeA =。

要修复您的特定错误，您可以执行以下操作：

Set dataRangeA = Range("A4", Cells(Rows.Count, "A").End(xlUp))

但是，如果您的代码中使用了多个工作表/工作簿，则使用不合格的Cells和Range以及Rows是一种危险的习惯，因为这些对象默认引用ActiveSheet中的ActiveWorkbook，可能不是您期望的那个。

下面的代码确保每个对象都是合格的，并对代码进行一些其他改进（例如填充字典时出现的不可避免的内存不足错误）。

Sub Transfer2NewWorkbook()
  Dim currentsheet As String
  Dim newsheet As String
  Dim analysisDate As String
  Dim initial As String
  Dim aInitial() As String
  Dim analystInit As String
  Dim batchNo As String

  Dim wb As Object
  Dim dataRangeA As Range, dataRangeB As Range, dataRangeI As Range
  Dim dataA As Object ' declare this, unless you have declared it at a higher
                      ' level scope

  Set dataA = CreateObject("Scripting.Dictionary")

  ' Grab and Create filenames
  currentsheet = ActiveWorkbook.Name
  newsheet = currentsheet & "-" & "uploadable"

  'Use a With block to avoid having to constantly refer
  ' to "ActiveWorkbook.Sheets(1)"
  With ActiveWorkbook.Sheets(1)
    ' Grab data from original spreadsheet
    analysisDate = .Cells(1, 9).Value

    initial = .Cells(1, 2).Value
    aInitial = Split(initial, "/")
    analystInit = aInitial(1)

    Set dataRangeA = .Range("A4", .Cells(.Rows.Count, "A").End(xlUp))
    Set dataRangeB = .Range("B4", .Cells(.Rows.Count, "B").End(xlUp))
    Set dataRangeI = .Range("I4", .Cells(.Rows.Count, "I").End(xlUp))

    'This loop is making every entry in the Dictionary contain the value of 
    'every cell in the range - i.e. each of the 1048573 entries in the Dictionary
    'would have contained an array which was dimensioned As (1 To 1048573, 1 To 1)
    'For i = 1 To dataRangeA.Rows.Count
    '  dataA.Add Key:=i, Item:=dataRangeA.Cells.Value
    'Next i
    Dim cel As Range
    For Each cel in dataRangeA
      dataA.Add Key:=cel.Row, Item:=cel.Value
      'or 
      'dataA.Add Key:=cel.Row - 3, Item:=cel.Value
      'if you wanted A4's value to have a key of 1
    Next

    'Note: If you just wanted an array of values, you could have used
    '  Dim dataA As Variant
    '  dataA = Application.Transpose(.Range("A4", .Cells(.Rows.Count, "A").End(xlUp)))
    'and then access each value using dataA(1) for the value from A4,
    'dataA(2) for the value from A5, etc.
    'This then gets rid of the need for dataRangeA, and the need for a
    ' dictionary object, and the need for the loop populating the dictionary.
  End With

  Set wb = Workbooks.Add("C:\Users\dalythe\documents\uploadtemp.xlsx")
  With wb.Worksheets(1)

    .Cells(3, 2).Value = analysisDate
    .Cells(3, 4).Value = analystInit

  End With
  wb.SaveAs newsheet & ".xlsx"


End Sub

无法使用VBA

3 个答案: