我想根据某个标准将一些名称从另一个文件复制到一个数组中

时间:2015-07-12 04:32:53

标签: excel-vba vba excel

我想根据特定条件将其他文件中的某些名称复制到数组中,然后将该数组粘贴到调用文件中。 我写的代码不起作用。我在这里想念的是什么?

Private Sub CommandButton1_Click() 
    Workbooks.Open ("D:\Slave.xlsx") 
    ActiveWindow.Visible = False 
    Windows("Slave.xlsx").Activate 
    Sheet1.Activate 
    For i = 1 To 5 
        names(i) = Sheet1.Cells(i, 1) 
    Next 
    Windows("Slave.xlsx").Close 
    Sheet1.Activate 
    For n = 1 To 5 
        Sheet1.Cells(n + 10, 1) = names(n) 
    Next 
End Sub 

1 个答案:

答案 0 :(得分:0)

Private Sub CommandButton1_Click()
    Dim myNames() As String
    ReDim myNames(1 To 5)
    Workbooks.Open ("D:\Slave.xlsx")
    ActiveWindow.Visible = False
    Windows("Slave.xlsx").Activate
    Sheet1.Activate
    For i = LBound(myNames) To UBound(myNames)
        myNames(i) = Sheet1.Cells(i, 1)
    Next
    Windows("Slave.xlsx").Close
    Sheet1.Activate
    For n = LBound(myNames) To UBound(myNames)
        Sheet1.Cells(n + 10, 1) = myNames(n)
    Next
End Sub

我不知道Names本身是否是对限制访问属性的引用,或者您事先没有声明它,所以我在脚本中将其更改为myNames() 。现在,摄入量和输出量只需一个动态声明,可能会让您在将来遇到一些麻烦 出于展示的唯一目的,我还创建了一个更多的PC子,它不会闪现更多,并且可能运行得更快(特别是如果数据集更大):

Private Sub CommandButton1_Click()
Dim myNames() As Variant, wb(1) As Workbook, ws As Worksheet
ReDim myNames(1 To 5)
On Error GoTo wsOrwbDoesntExist
Set wb(0) = ThisWorkbook
Set wb(1) = Workbooks.Open("D:\Slave.xlsx")
    wb(1).Windows(1).Visible = False
Set ws = wb(1).Worksheets("Sheet1")
    'ActiveWindow.Visible = False 'what's this?
For i = LBound(myNames) To UBound(myNames)
    myNames(i) = ws.Cells(i, 1).Value2
Next

wb(1).Close (SaveChanges = False)
Set ws = wb(0).Worksheets("Sheet1")

For n = LBound(myNames) To UBound(myNames)
    ws.Cells(n + 10, 1).Value2 = myNames(n)
Next
Exit Sub
wsOrwbDoesntExist:
MsgBox "Referenced workbook or worksheet may not exist." & vbNewLine & "Please run this sub in debug mode."
End Sub