dimanche 26 juin 2016

List(Of ) like operation in macro

I have a macro that I am trying to get running a little more quickly. The intent of the macro is to merge multiple files into one. These files contain a unique ID for each item, some descriptive information about the item, and some measurement outcomes for each item. The measurement outcomes are what differ between the files.

In all the files, each item occupies a row, with the measurements in columns. No file lists all the items, but some items do appear in more than one file.

Currently, I iterate through the files and either use the data to update an existing row (for the items in a file that's already been processed), or create a new row if the item hasn't appeared in any previous file.

The place I'm losing a good chunk of time, especially on the later files, is finding the row for an item I've already added to the unified list, so that I can add the new measurement values to the appropriate column(s).

Function MMFProcessor(sfol As String, ifn As String, x As Integer, os As Worksheet, NPU As String, Prods As String, sw As StatWin, PM As String, _
FlgMeas() As String, m As Long, MKO As String, OName As String, Optional Ambetter As Boolean = False) As Variant()
'
Dim src As Workbook 'workbook containing the info to copy to unified list
Set src = Workbooks.Open(sfol & "" & ifn & Right(Year(Now() - 25), 2) & "_.xlsx")
Dim mks As String
Dim mgc As String 
Dim sm As String
Dim FMC As Boolean
FMC = False 'want to only check that the filled length of FlgMeas & FMCol match once
Dim ret As Boolean 'whether the function completed successfully
ret = True 'easier to ID failures rather than only setting to True on success
Dim RArr(3) As Variant 'return
Dim fnd As Boolean
Dim y As Integer

'...(non-relevant code)

    'Iterate through the rows to output data
    Dim k As Long 'Source row being worked with
    Dim OutF As Boolean 'used to stop loop for flag column setting after column is found & set
    k = 2
    Do While src.Worksheets(1).Range("A" & k).Value <> "" And ret
        'Product match?
        If InStr(1, LCase(Prods), "|" & LCase(src.Worksheets(1).Range(mgc & k).Value) & "|") > 0 Or _
            (Ambetter And InStr(1, LCase(src.Worksheets(1).Range(mgc & k).Value), "ambetter") > 0) Then
            'Check if the item is new
            If InStr(1, PM, "|" & src.Worksheets(1).Range(mks & k).Value & "|") = 0 Then
                'New add it to PM
                PM = PM & "|" & src.Worksheets(1).Range(mks & k).Value & "|"

                'Output the descriptive info
                For y = 0 To x
                    'UnMapped column?
                    If ColDict(y, 1) <> "" Then
                        'Output the value
                        os.Range(ColDict(y, 0) & m).Value = src.Worksheets(1).Range(ColDict(y, 1) & k).Value
                    End If 'else the cell should be left blank, which is the default
                Next

                'Set the appropriate flag column
                Call FlagSet(FlgMeas(), src, os, sm, k, m, sw, OName)

                'Increment m
                m = m + 1

            Else
                'Find the item's row (in general it will be the last row filled, so we'll decrement from the end of the list rather then increment from the start)
                Dim n As Long
                n = m - 1
                fnd = False
                Do While n > 1 And fnd = False
                    If os.Range(MKO & n).Value = src.Worksheets(1).Range(mks & k).Value Then
                        'Set the appropriate flag column
                        Call FlagSet(FlgMeas(), src, os, sm, k, n, sw, OName)

                        fnd = True
                    Else
                        n = n - 1
                    End If
                Loop

                If Not fnd Then
                    'post notice if we haven't already for this item and this file
                    If OldOName <> OName Then
                        'Update OldOName and clear INotFnd
                        OldOName = OName
                        INotFnd = ""
                    End If

                    'Check if item is in INotFnd (if we've changed files INotFnd will be empty)
                    If InStr(1, INotFnd, "|" & src.Worksheets(1).Range(mks & k).Value & "|") = 0 Then
                        Call Err("Item: " & src.Worksheets(1).Range(mks & k).Value & " is noted as already being present in the " & OName & " list, but" _
                            & " that row could not be located to update the item's measurement values, meaning one or more of the values will be incorrect" _
                            & ". Please be sure to make this change manually.", sw)
                        INotFnd = INotFnd & "|" & src.Worksheets(1).Range(mks & k).Value & "|"
                    End If 'else no need to repeat for same item
                End If
            End If
        End If 'non-<Products> items don't get reported

        k = k + 1
    Loop
End If 'else the arrays didn't match up and we've already notified the user

'...(more irrelevant code)

FlgMeas() is an array that maps the measurement columns' names to the column that measure should be output to; mks is the column letter of the column that has the item IDs

As I mentioned at the beginning, this works, but it will sometimes have to iterate back through over 20k rows to find the right one. Currently that leaves the merge taking over 2 hrs, and I've just been directed to include more files (thus why I'm wanting to shave down the run time).

So what I was hoping to get was something that works like VB Lists, where I could look-up a value (in this case the row to output to) based on a value (the ID) without having to iterate explicitly.

Failing any such thing existing in native VBA, would it be faster for me to maintain PM (the list of previously output IDs) as a 2D array, holding IDs & row #s, and iterate through that rather than the actual rows?

Thanks in advance!

Aucun commentaire:

Enregistrer un commentaire