循环并将单元格值放入数组后，VBA数组为空

Question

我有一个正在处理的宏，如果一个单元格的值等于IN，它就会循环并将单元格的值存储到数组中。由于某些原因，数组是空的。我是VBA新手，我怀疑我可能没有正确地检索单元格值。下面是我的代码，任何帮助都是感谢提前感谢。

注意:运行宏的excel工作表实际上包含这些单元格中的内容，其中有几个单元格的值为IN。

    Option Explicit

'Variable Definitions ***********************************************************
Dim WorkbookSize As Long 'Var to hold number of rows in worksheet, used primarily to control loops
Dim newbook As Boolean 'Flag if new book was created correctly
Dim wb As Workbook 'var to hold workbook object
Dim TempPath As String 'var to hold local temp path to store newly created workbook
Dim i As Integer 'var used as counter for loops
Dim activeBook As String 'var to hold new workbook name


'Main Driver
Sub Main()
    WorkbookSize = size() 'Run function to get workbook size
    newbook = False
    Call create            'Run sub to create new workbook
    Call pull(WorkbookSize)              'Run sub to pull data
End Sub

'Get size of Worksheet
Function size() As Long
    size = Cells(Rows.Count, "A").End(xlUp).Row
End Function

'Create workbook
Sub create()
    Set wb = Workbooks.Add
    TempPath = Environ("temp") 'Get Users local temp folder
    With wb
        .SaveAs Filename:=TempPath & "EDX.xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        .ChangeFileAccess Mode:=xlReadOnly, WritePassword:="admin"
    End With
End Sub

'pull data
Sub pull(size)
    Dim code() As Variant
    ReDim code(size - 1)
    For i = 1 To size
    'Check code column fo IN and Doctype column for 810
        If Cells(i, 17).Value = "IN" Then
            code(i) = Cells(i, 17).Value 'store in array
        End If
    Next i
     Call push(code)
End Sub

'push data to new workbook
Sub push(ByRef code() As Variant)
    activeBook = "TempEDX.xlsm"
    Workbooks(activeBook).Activate 'set new workbook as active book
    Dim txt As String
    For i = 1 To UBound(code)
        txt = txt & code(i) & vbCrLf
        'Cells(i + 1, 1).Value = code(i)
    Next i
    MsgBox txt
End Sub

Answer 1

您应该完全限定对Cells属性的调用。否则，Cells将使用活动工作簿和工作表。在您的示例中，您在使用pull方法扫描之前已经创建了一个工作簿。所以你实际上是在看一个空的工作表。

在拉取后创建新的工作簿，或者创建新的工作表变量并在开始时设置它，如下所示：

dim currentWorksheet as Worksheet
set currentWorksheet = Activesheet

然后，您应该将currentWorksheet传递给pull函数和size函数。

我会这样做：

    Option Explicit

'Variable Definitions ***********************************************************
Dim WorkbookSize As Long 'Var to hold number of rows in worksheet, used primarily to control loops
Dim newbook As Boolean 'Flag if new book was created correctly
Dim wb As Workbook 'var to hold workbook object
Dim TempPath As String 'var to hold local temp path to store newly created workbook
Dim i As Integer 'var used as counter for loops
Dim activeBook As String 'var to hold new workbook name


'Main Driver
Sub Main()
    Dim currentWorksheet As Worksheet
    Set currentWorksheet = ActiveSheet

    WorkbookSize = size(currentWorksheet) 'Run function to get workbook size
    newbook = False
    Dim values()
    values = pull(currentWorksheet, WorkbookSize)               'Run sub to pull data
    push create(), values
End Sub

'Get size of Worksheet
Function size(sh As Worksheet) As Long
    size = sh.Cells(Rows.COUNT, "A").End(xlUp).row
End Function

'Create workbook
Function create() As Workbook
    Set wb = Workbooks.Add
    TempPath = Environ("temp") 'Get Users local temp folder
    With wb
        .SaveAs Filename:=TempPath & "EDX.xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        .ChangeFileAccess Mode:=xlReadOnly, WritePassword:="admin"
    End With

    Set create = wb
End Function

'pull data
Function pull(pullFromSheet As Worksheet, size) As Variant
    Dim code() As Variant
    ReDim code(size - 1)
    For i = 1 To size
    'Check code column fo IN and Doctype column for 810
        If pullFromSheet.Cells(i, 17).Value = "IN" Then
            code(i-1) = pullFromSheet.Cells(i, 17).Value 'store in array
        End If
    Next i
    pull = code
End Function

'push data to new workbook
Sub push(toWorkbook As Workbook, ByRef code() As Variant)
    'activeBook = "TempEDX.xlsm"

    'Workbooks(activeBook).Activate 'set new workbook as active book
    Dim newSheet As Worksheet
    Set newSheet = toWorkbook.Sheets(1)
    Dim txt As String
    For i = 0 To UBound(code)
        txt = txt & code(i) & vbCrLf
        newSheet.Cells(i + 1, 1).Value = code(i)
    Next i
    MsgBox txt
    newSheet.Activate 'just to make your new sheet active for the user
End Sub

我将Push代码移到了pull代码之外，还创建了函数而不是subs，这样您就可以很好地处理正在创建的新对象。

Answer 2

我认为您没有选择正确的页面。

放入一个

Sheets("NAME_OF_SHEET").Select

在for之前，就像

Sub push(ByRef code() As Variant)
  activeBook = "TempEDX.xlsm"
  Workbooks(activeBook).Activate 'set new workbook as active book
  Dim txt As String

  Sheets("NAME_OF_SHEET").Select
  For i = 1 To UBound(code)
      txt = txt & code(i) & vbCrLf
      'Cells(i + 1, 1).Value = code(i)
  Next i
  MsgBox txt
End Sub

谢谢