Excel单元格/范围逻辑作为数组逻辑

I am working with alphanumeric data from a mainframe. Due to the nature of the access point, the GetString method is used within a webbrowser interface to pull data from the mainframe. I am refactoring my code as well as older code to make use of data structures instead of merely range objects, as range object code takes far longer with large data sets.

我正在处理来自大型机的字母数字数据。由于访问点的性质，GetString方法在webbrowser接口中用于从大型机中提取数据。我正在重构我的代码以及旧代码以使用数据结构而不仅仅是范围对象，因为对于大型数据集，范围对象代码需要更长的时间。

As a part of general optimization practice, I run all large data set macros with Application.ScreenUpdating = False and Application.Calculation = xlCalculationManual active. To time it, I use QueryPerformanceCounter with a DoEvents after using the Counter in conjunction with the statusbar, so that it provides me the time it takes to complete a particular macro. The QueryPerformanceCounter is located in a Class Module and has played no direct role in executing the domain logic / business logic of my code.

作为一般优化实践的一部分，我运行所有大型数据集宏，其中Application.ScreenUpdating = False，Application.Calculation = xlCalculationManual处于活动状态。为了计时，我在将Counter与状态栏结合使用后将QueryPerformanceCounter与DoEvents一起使用，这样它就可以为我提供完成特定宏所需的时间。 QueryPerformanceCounter位于类模块中，在执行代码的域逻辑/业务逻辑时没有直接作用。

For instance, I recently refactored code that pulled 10,000 or so strings from the mainframe screen and placed them into a worksheet via a loop. When refactored into a datastructure loop, the code takes around 70 seconds when shucking the strings into an array. The code is also more portable, in that those strings could as easily be shifted/placed to a dictionary for sorting or a collection for parsing. I am therefore switching all my VBA code from range-based to datastructures, and this is the lead-in/background for my question.

例如，我最近重构了代码，该代码从大型机屏幕中提取了大约10,000个字符串，并通过循环将它们放入工作表中。当重构为数据结构循环时，将字符串转移到数组中时，代码大约需要70秒。代码也更加可移植，因为这些字符串可以很容易地移位/放置到字典中进行排序或者用于解析。因此，我将所有VBA代码从基于范围的代码切换到数据结构，这是我的问题的引入/后台。

I came across some older code during an analysis project that has some interesting logic for pulling content from the mainframe. In essence, the code pulls content from the server in this layout form:

我在分析项目中遇到了一些旧代码，它有一些从大型机中提取内容的有趣逻辑。本质上，代码以此布局形式从服务器中提取内容：

And then parses the the content into this form in an excel sheet using Worksheet/Cell logic as a framework:

然后使用Worksheet / Cell逻辑作为框架在Excel工作表中将内容解析为此表单：

The code, sans the login/access logic as well as sans subroutine declarations, is as follows:

没有登录/访问逻辑以及sans子例程声明的代码如下：

Sub AcquireData()

    CurrentServerRow = 13

    WhileLoopHolder = 1

    If Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 9, 7)) <> "" Then

        NewWorksheetLine_Sub

    End If

    Do While WhileLoopHolder = 1

        If CurrentSession.Screen.Getstring(CurrentServerRow, 9, 1) = "-" Then

            If Trim(CurrentSession.Screen.Getstring(CurrentServerRow + 1, 15, 1)) <> "" Then

                NewWorksheetLine_Sub

            End If

        ElseIf Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 9, 7)) = "" Then

            If Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 58, 14)) <> "" Then
                Cells(WorksheetRow, ValueSets) = Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 58, 14))
                ValueSets = ValueSets + 1
            End If

        Else

            If CurrentSession.Screen.Getstring(CurrentServerRow, 5, 1) = "" Then

                Cells(WorksheetRow, WorksheetColumn) = "X"

            Else

                Cells(WorksheetRow, WorksheetColumn) = CurrentSession.Screen.Getstring(CurrentServerRow, 5, 1)

            End If

            Cells(WorksheetRow, WorksheetColumn + 1) = CurrentSession.Screen.Getstring(CurrentServerRow, 9, 7)
            Cells(WorksheetRow, WorksheetColumn + 2) = Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 17, 39))
            Cells(WorksheetRow, ValueSets) = Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 58, 14))
            WorksheetColumn = WorksheetColumn + 3
            ValueSets = ValueSets + 1

        End If

        CurrentServerRow = CurrentServerRow + 1

        If CurrentServerRow > 41 Then

            WhileLoopHolder = 0

        End If

    Loop

End Sub

Sub NewWorksheetLine_Sub()

        WorksheetRow = WorksheetRow + 1
        WorksheetColumn = 1
        ValueSets = 10

End Sub

This code is nested in a loop within another program, and thereby pulls thousands of lines and organizes them neatly. It also takes hours and wastes valuable time that could be used analyzing the data acquired from the server. I managed to refactor the basic code into a data structure, and used my learning to refactor other code as well. Unfortunately, I refactored this particularly code incorrectly, as I am unable to mimic the business logic correctly. My snippet is as follows:

这段代码嵌套在另一个程序的循环中，从而拉出数千行并整齐地组织它们。它还需要数小时，浪费宝贵的时间，可用于分析从服务器获取的数据。我设法将基本代码重构为数据结构，并使用我的学习来重构其他代码。不幸的是，我错误地重构了这个特别的代码，因为我无法正确地模仿业务逻辑。我的片段如下：

Sub AcquireData()
'This code refactors the data into a datastructure from a range object, but does not really capture the logic.
'Also, There is an error in attempting to insert a variant array into a collection/dictionary data structure.


CurrentServerRow = 13

ReDim SourceDataArray(10)

WhileLoopHolder = 1

If Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 9, 7)) <> "" Then

    NewWorksheetLine_Sub

End If

Do While WhileLoopHolder = 1

    If CurrentSession.Screen.Getstring(CurrentServerRow, 9, 1) = "-" Then

        If Trim(CurrentSession.Screen.Getstring(CurrentServerRow + 1, 15, 1)) <> "" Then

            NewWorksheetLine_Sub

        End If

    ElseIf Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 9, 7)) = "" Then

        If Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 58, 14)) <> "" Then

            ReDim Preserve SourceDataArray(ValueSets)
            SourceDataArray(ValueSets) = Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 58, 14))

            ValueSets = ValueSets + 1
            ReDim Preserve SourceDataArray(ValueSets)
        End If

    Else

        If CurrentSession.Screen.Getstring(CurrentServerRow, 5, 1) = "" Then

            ReDim Preserve SourceDataArray(WorkSheetColumn)
            SourceDataArray(WorkSheetColumn) = "X"

        Else

            SourceDataArray(WorkSheetColumn) = CurrentSession.Screen.Getstring(CurrentServerRow, 5, 1)

        End If

        SourceDataArray(WorkSheetColumn + 1) = CurrentSession.Screen.Getstring(CurrentServerRow, 9, 7)

        SourceDataArray(WorkSheetColumn + 2) = Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 17, 39))

        SourceDataArray(ValueSets) = Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 58, 14))

        WorkSheetColumn = WorkSheetColumn + 3
        ValueSets = ValueSets + 1
        ReDim Preserve SourceDataArray(ValueSets)

    End If

    CurrentServerRow = CurrentServerRow + 1

    If CurrentServerRow > 41 Then

        WhileLoopHolder = 0

    End If

Loop

End Sub

Sub NewWorksheetLine_Sub()

SourceIndexAsString = SourceCollectionIndex

   SourceDataCollection.Add SourceDataArray(), SourceIndexAsString

    SourceCollectionIndex = SourceCollectionIndex + 1
    WorkSheetColumn = 1
    ValueSets = 10

End Sub

I have considered that in order to use the same type of "cell" logic, I may want to use arrays nested within an array, and then transpose that to a worksheet. However, I have been thus far unsuccessful in implementing any such solution these past few weeks. Also, there may be a superior method of refactoring the logic to a datastructure form. However, I have been unable to determine how to do so successfully.

我已经考虑过为了使用相同类型的“单元”逻辑，我可能想要使用嵌套在数组中的数组，然后将其转置到工作表中。但是，到目前为止，我在过去几周内未能成功实施任何此类解决方案。此外，可能有一种将逻辑重构为数据结构形式的优良方法。但是，我一直无法确定如何成功。

To summarize, my questions are as follows: In what way(s) can I shift "cell"-based logic to data structure logic? What is the best data structure for doing so? In this particular case, how can I implement the use of data structure logic with the this business logic?

总而言之，我的问题如下：我可以用什么方式将“基于单元”的逻辑转换为数据结构逻辑？这样做的最佳数据结构是什么？在这种特殊情况下，如何使用此业务逻辑实现数据结构逻辑的使用？

3 个解决方案

#1

Some of the use of ReDim Preserve seems problematic.

ReDim Preserve的一些使用似乎有问题。

If CurrentSession.Screen.Getstring(CurrentServerRow, 5, 1) = "" Then
  ReDim Preserve SourceDataArray(WorkSheetColumn)
  SourceDataArray(WorkSheetColumn) = "X"

So if WorksheetColumn had the value 1 we would have reduced SourceDataArray to being one entry in size and discarded all of the data in the higher locations in the array.

因此，如果WorksheetColumn的值为1，我们将SourceDataArray减小为一个大小的条目，并丢弃数组中较高位置的所有数据。

Else
  SourceDataArray(WorkSheetColumn) = CurrentSession.Screen.Getstring(CurrentServerRow, 5, 1)
End If

SourceDataArray(WorkSheetColumn + 1) = CurrentSession.Screen.Getstring(CurrentServerRow, 9, 7)

SourceDataArray(WorkSheetColumn + 2) = Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 17, 39))

Now we are potentially looking at entries in SourceDataArray which don't exist (i.e. when the If branch above was followed rather than the Else branch) and we should get a "Subscript out of range" error

现在我们可能会查看SourceDataArray中不存在的条目（即当遵循上面的If分支而不是Else分支时），我们应该得到“下标超出范围”错误

ReDim Preserve only retains the data for array elements which make sense with the new array size. So if we have ReDim a(10) and then later have ReDim Preserve a(5) (and assume that arrays start at element 0 - i.e. no Option Base 1) then a(5) through a(9) now are inaccessible and the data they contained is lost

ReDim Preserve仅保留数组元素的数据，这些元素对新数组大小有意义。因此，如果我们有ReDim a（10）然后让ReDim保留a（5）（并假设数组从元素0开始 - 即没有Option Base 1）那么a（5）到a（9）现在是不可访问的并且他们包含的数据丢失了

#2

To refactor the code that uses cell references into an array you need to use a 2 dimensional array.
Cell references are 1 based, so you should stick to that in your array too.

要将使用单元格引用的代码重构为数组，您需要使用二维数组。单元格引用是基于1的，所以你应该坚持在你的数组中。

You can copy Ranges to and from arrays using the Range.Value property

您可以使用Range.Value属性将范围复制到数组或从数组复制范围

' Range to array
Dim a as Variant
a = Range("A1:J100").Value

will result in a being a variant array of size 1 To 100, 1 To 10

将导致一个大小为1到100,1到10的变体数组

' Array to Range
Dim a(1 To 100, 1 To 10) as Variant
' populate a
' ...
' Put a into a range
Range("A1:J100").Value = a

These two code snippets result in the same output, but the second runs much faster

这两个代码片段产生相同的输出，但第二个运行速度更快

Dim r as Long, c as Long
For r = 1 To 1000
For c = 1 To 100
    Cells(r, c) = r * c
Next c, r


Dim r as Long, c as Long
Dim a() as Variant 
Redim a(1 To 1000, 1 To 100)   
For r = 1 To 1000
For c = 1 To 100
    a(r, c) = r * c
Next c, r
Range("A1:CV1000") = a

---

ReDim Preserve is a relatively expensive operation, so it's faster to ReDim in chunks

ReDim Preserve是一个相对昂贵的操作，因此ReDim的块更快

Rather than this

而不是这个

Redim a(1 To 10, 1 To 1)
For 1 = 1 to 100000
    Redim Preserve a(1 To 10, 1 To i)
    a(i) = SomeValue
Next

Do this instead

这样做

Redim a(1 To 10, 1 To 1000)
For 1 = 1 to 100000
    If i > UBound(a) Then
        Redim Preserve a(1 To 10, 1 To UBound(a) + 1000)
    End If
    a(i) = SomeValue
Next
Redim Preserve a (1 To 10, 1 To i - 1)

---

Redim Preserve can only change the last dimension of a multi dimensional array.

Redim Preserve只能更改多维数组的最后一个维度。

Eg This works

这样可行

Redim a(1 to 100, 1 To 10)
Redim Preserve a(1 to 100, 1 To 20)

This does not work

这不起作用

Redim a(1 to 100, 1 To 10)
Redim Preserve a(1 to 200, 1 To 20)

Usually when working with arrays representing ranges, its the number of rows that varies most. This presents a problem, since the Range.Value array is (1 To Rows, 1 To Columns)

通常在使用表示范围的数组时，它的行数变化最大。这提出了一个问题，因为Range.Value数组是（1 To Rows，1 To Columns）

A work around is to actually dimension your array (1 To Columns, 1 To Rows). Redim number of rows as required, then Transpose into the destination range

解决方法是实际确定数组的尺寸（1到列，1到行）。根据需要重新划分行数，然后转置到目标范围

Dim r As Long, c As Long
Dim a() As Variant
ReDim a(1 To 100, 1 To 200)
For r = 1 To 1000
For c = 1 To 100
    If r > UBound(a, 2) Then
        ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 200)
    End If
    a(c, r) = r * c
Next c, r
Range("A1:CV1000") = Application.Transpose(a)

If you need to vary both dimensions, to change the first dimension will require creating a new array of the required size and copying the data from the old array to the new one. Again, redim like this in chunks to avoid too many redim's

如果需要改变两个维度，要更改第一个维度，则需要创建所需大小的新数组，并将数据从旧数组复制到新数组。再次，像这样重新整理以避免过多的redim

One last thing: you don't seem to Dim your variable (unless you've just left this part out of you post). I would reccomend you use Option Explicit and Dim all your variables. This helps to avoid data type mistakes, and also avoids using Variant for everything. Variants are fine when you need then, but when you don't, other data types are usually faster.

最后一件事：你似乎没有暗淡你的变量（除非你刚离开这部分你的帖子）。我建议您使用Option Explicit和Dim所有变量。这有助于避免数据类型错误，并且还可以避免将Variant用于所有内容。当你需要时变量很好，但是当你不需要时，其他数据类型通常会更快。

#3

Once I spent a few weeks refactoring other macros from range-based logic to abstracted data structure logic, the answer hit me once I returned to this macro. If I am merely mimicking the range logic so as to more quickly complete the macro, then I need only fill the array such that it matches the range once it is transposed. This means that I do not need to trim the array or in any way manipulate its form - I only need to fill the data structure in array form, and then transpose it to the spreadsheet. I can also make alternative use of the data once the array is filled up.

一旦我花了几周时间将其他宏从基于范围的逻辑重构为抽象的数据结构逻辑，一旦我回到这个宏，答案就会打动我。如果我只是模仿范围逻辑以便更快地完成宏，那么我只需要填充数组，使其在转置后匹配范围。这意味着我不需要修剪数组或以任何方式操纵它的形式 - 我只需要以数组形式填充数据结构，然后将其转置到电子表格中。阵列填满后，我也可以替代使用数据。

Here is the solution code:

这是解决方案代码：

Sub AcquireData()

'The array 'MyArray' was dimensioned as a dynamic array in the declarations section at the top of the module.
'Redim the array to a big 2 dimensional array that fits the needs of the data/macro.
ReDim MyArray(1 To 20, 1 To 20000)

'From here on, simply mimic the logic of the range macro... [i]
CurrentServerRow = 13

WhileLoopHolder = 1

If Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 9, 7)) <> "" Then

    NewWorksheetLine_Sub

End If

Do While WhileLoopHolder = 1

    If CurrentSession.Screen.Getstring(CurrentServerRow, 9, 1) = "-" Then

        If Trim(CurrentSession.Screen.Getstring(CurrentServerRow + 1, 15, 1)) <> "" Then

            NewWorksheetLine_Sub

        End If

    ElseIf Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 9, 7)) = "" Then

        If Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 58, 14)) <> "" Then

            '[i] ... except, move the values into the array in Column, Row logic form.
            MyArray(ValueSets, WorksheetRow) = Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 58, 14))
            ValueSets = ValueSets + 1
        End If

    Else

        If CurrentSession.Screen.Getstring(CurrentServerRow, 5, 1) = "" Then

            MyArray(WorksheetColumn, WorksheetRow) = "X"

        Else

            MyArray(WorksheetColumn, WorksheetRow) = CurrentSession.Screen.Getstring(CurrentServerRow, 5, 1)

        End If

        MyArray(WorksheetColumn + 1, WorksheetRow) = CurrentSession.Screen.Getstring(CurrentServerRow, 9, 7)
        MyArray(WorksheetColumn + 2, WorksheetRow) = Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 17, 39))
        MyArray(ValueSets, WorksheetRow) = Trim(CurrentSession.Screen.Getstring(CurrentServerRow, 58, 14))
        WorksheetColumn = WorksheetColumn + 3
        ValueSets = ValueSets + 1

    End If

    CurrentServerRow = CurrentServerRow + 1

    If CurrentServerRow > 41 Then

        WhileLoopHolder = 0

    End If

Loop

ArrayToWorkSheet_Sub

End Sub

Sub NewWorksheetLine_Sub()

    WorksheetRow = WorksheetRow + 1
    WorksheetColumn = 1
    ValueSets = 10

End Sub

'When finished with the loop, push the array to the worksheet, and transpose it to provide the correct column to row relationship in the spreadsheet.
Sub ArrayToWorkSheet_Sub()

Dim ArrayLimit As Long

Dim LastCell As Long

Dim MyRange As Range

'This level of precision in setting the range appears unnecessary, but in theory I think it could speed up tranposing the array - [ii]
'[ii]but that is just speculation. Performance improvements for the tranposition appear to be minor, perhaps due to the fact that [iii]
'[iii]most - if not nearly all - of the intense computations occur earlier.
With Sheets("Sheet2")

ArrayLimit = UBound(MyArray, 2)

LastCell = ArrayLimit + 1

Set MyRange = .Range("A2:S" & LastCell)

MyRange = WorksheetFunction.Transpose(MyArray)

End With

End Sub

While both Application.ScreenUpdating = False and Application.Calculation = xlCalculationManual are invaluable in reducing macro runtime, I have had very positive experiences with combining those two lines with the use of abstracted data structures. It appears that data structures, in certain cases, appear to help in optimizing performance, especially where extensive line by line data extraction is involved in the macro process.

虽然Application.ScreenUpdating = False和Application.Calculation = xlCalculationManual在减少宏运行时方面都是非常宝贵的，但我在将这两行与抽象数据结构结合使用方面有非常积极的经验。在某些情况下，数据结构似乎有助于优化性能，尤其是在宏过程中涉及大量逐行数据提取的情况下。