我有一个我正在研究的宏,如果单元格值等于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
您应该完全符合您对Cells
财产的要求。否则Cells
使用活动工作簿和工作表。在您的情况下,您在使用pull方法扫描之前已创建了工作簿。所以你基本上看一个空的工作表。
您拉动后创建新工作簿,或者创建一个新的Worksheet变量并在开头设置它,如:
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,因此您在创建的新对象上有很好的句柄。
我认为你没有选择合适的表格。
放一个
Sheets("NAME_OF_SHEET").Select
在之前,喜欢
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
谢谢