简体   繁体   中英

Easier way of Importing data into excel - collections?

Is there an easier way of importing data into an excel array or other data structure? I've tried researching collections but I have found the documentation hard to comprehend. http://www.functionx.com/vbaexcel/objects/Lesson6.htm

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

The code I have below opens a select file and searches for the column header and then loops through each row storing the data according to header and row variables, I've done this method for many macros in the past but now I am dealing with many many columns and I'm looking for a more advanced way?

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

The only thing we can help you eliminate is the for loop in the middle of you code. The rest seems to be necessary.

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

With Option Explicit some more Dim were necessary (which I included in the above soluion).

Note: just found this solution here: use variable for row_num application.index

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM