更轻松地将数据导入excel - 集合?

时间:2016-06-02 19:05:44

标签: arrays excel vba excel-vba data-structures

是否有更简单的方法将数据导入excel数组或其他数据结构?我尝试过研究收藏品,但我发现文档难以理解。 http://www.functionx.com/vbaexcel/objects/Lesson6.htm

https://msdn.microsoft.com/en-us/library/f26wd2e5%28v=vs.100%29.aspx

我下面的代码打开一个选择文件并搜索列标题,然后根据标题和行变量遍历存储数据的每一行,我已经为过去的许多宏完成了这个方法,但现在我已经处理许多专栏,我正在寻找更先进的方法?

Sub Import_NAVRec()

MyPath = Range("b2")                                'Defines cell that contains path to source file
Workbooks.Open (MyPath)                             'Opens file
Set tempbook = ActiveWorkbook                       'Names workbook
LR = Range("A65000").End(xlUp).Row                  'finds last row in sourcefile



ReDim aNavRec(1 To LR, 1 To 4)                      'Defines NAV Rec array
nRow = 0


 cName = "Accounting Basis"
 CA = Cells.Find(What:=UCase(cName), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column
 cName = "Accounting Date"
 cB = Cells.Find(What:=UCase(cName), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column
 cName = "Asset Currency"
 cC = Cells.Find(What:=UCase(cName), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column

     For r = 2 To LR
        'If Cells(r, cB) = "Trading Gain Loss" Then
         nRow = nRow + 1
         aNavRec(nRow, 1) = Cells(r, CA) 'Fund Number
         aNavRec(nRow, 2) = Cells(r, cB) 'Ledger
         aNavRec(nRow, 3) = Cells(r, cC) 'Balance change
        'End If

     Next r


tempbook.Close
End Sub

Sub Print_output()

Sheets("Output").Select
Set Destination = Range("a2")
Destination.Resize(UBound(aNavRec, 1) + 1, UBound(aNavRec, 2)).Value = aNavRec


End Sub

1 个答案:

答案 0 :(得分:0)

我们唯一可以帮助您消除的是代码中间的for循环。其余的似乎是必要的。

Option Explicit

Sub Import_NAVRec()

Dim LR As Long
Dim MyPath As String
Dim aNavRec As Variant                              'Defines NAV Rec array
Dim tempbook As Workbook
Dim CA As Long, cB As Long, cC As Long

MyPath = Range("B2")                                'Defines cell that contains path to source file
Workbooks.Open (MyPath)                             'Opens file
Set tempbook = ActiveWorkbook                       'Names workbook
LR = Range("A65000").End(xlUp).Row                  'finds last row in sourcefile

cName = "Accounting Basis"
CA = Cells.Find(What:=UCase(cName), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column
cName = "Accounting Date"
cB = Cells.Find(What:=UCase(cName), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column
cName = "Asset Currency"
cC = Cells.Find(What:=UCase(cName), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column

aNavRec = Application.Index(Range("A:AZ"), Application.Evaluate("Row(1:" & LR & ")"), Array(CA, cB, cC))

tempbook.Close
End Sub

Option Explicit需要更多Dim(我已将其纳入上述解决方案中)。

注意:在此处找到此解决方案:use variable for row_num application.index