简体   繁体   中英

Excel VBA using an array to speed up code

I am trying to create an array, store values in the array and then write the values of the array to a spreadsheet in VBA. This codes takes 1+ hour to run on my computer and I think that an array could really speed up the code.

However, I need help with creating the array, populating the array from the comboboxes and finally write the values of the array to the worksheet.

  1. Create an n-dimensional array
  2. Fill the n-dimensional array with the values of the ComboBoxes.
  3. Iterate through all ComboBoxes.
  4. Store values in the array
  5. Write values from the array to the spreadsheet

    Sub WantToUseArray()

     Dim k As Integer Dim l As Integer Sheets("Test").ComboBox1.ListIndex = 0 For l = 0 To 25 Sheets("Test").ComboBox3.ListIndex = l Sheets("Test").ComboBox2.ListIndex = 0 For n = 0 To 25 Sheets("Test").ComboBox4.ListIndex = n Sheets("Points").Select Dim LR As Long LR = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(LR, "A").Value = Sheets("Test").Range("G5").Value Cells(LR, "B").Value = Sheets("Test").Range("G6").Value Cells(LR, "C").Value = Sheets("Test").Range("O5").Value Cells(LR, "D").Value = Sheets("Test").Range("O6").Value Cells(LR, "E").Value = Sheets("Test").Range("X5").Value Cells(LR, "F").Value = Sheets("Test").Range("X6").Value Cells(LR, "G").Value = Sheets("Test").Range("G6").Value + Sheets("Test").Range("X6").Value Cells(LR, "H").Value = Sheets("Test").Range("X6").Value + Sheets("Test").Range("G6").Value Cells(LR, "I").Value = Sheets("Test").Range("K40").Value Cells(LR, "J").Value = Sheets("Test").Range("K41").Value Cells(LR, "K").Value = Sheets("Test").Range("K51").Value Cells(LR, "L").Value = Sheets("Test").Range("K52").Value Next Next End Sub 

This code goes through each combobox in a given worksheet , generates an array that contains the list values for each comobox list, then prints all of the contents into that first column. myArray only has a single dimension. Its contents are other arrays . If the comoboxes have different list lengths, a jagged array is created.

To help visualize the arrays , enable the Locals Window by going to view in the menu bar and then selecting Locals Window . See pic below the code.

Option Explicit
Sub main()
Dim ws                                                 As Worksheet
Dim mainArray()                                          As Variant
Dim ctrl                                               As Object
Dim numComboBoxes                                      As Long

    Set ws = ActiveSheet

    numComboBoxes = GetNumberOfComboBoxesInSheet(ws)
    mainArray = GenerateJaggedArrayComboBoxListValues(ws, numComboBoxes)
    PrintArray ws, mainArray
End Sub

Function GetNumberOfComboBoxesInSheet(ByRef ws As Worksheet) As Long
Dim ctrl As Object
    For Each ctrl In ws.OLEObjects
        If TypeName(ctrl.Object) = "ComboBox" Then
            GetNumberOfComboBoxesInSheet = GetNumberOfComboBoxesInSheet + 1
        End If
    Next ctrl
End Function

Function GenerateJaggedArrayComboBoxListValues(ByRef ws As Worksheet, ByVal numComboBoxes As Long) As Variant()
Dim ctrl                                                As Object
Dim tempPrimaryArray()                                  As Variant
Dim tempArray()                                         As Variant
Dim x                                                   As Long
Dim y                                                   As Long
Dim listNum                                             As Long

   ReDim tempPrimaryArray(0 To numComboBoxes - 1)
    x = 0
    For Each ctrl In ws.OLEObjects
        If TypeName(ctrl.Object) = "ComboBox" Then
            y = 0
            For listNum = 0 To ctrl.Object.ListCount - 1
                ReDim Preserve tempArray(0, 0 To y)
                tempArray(0, y) = ctrl.Object.List(listNum, 0)
                y = y + 1
            Next listNum
            tempPrimaryArray(x) = tempArray
            Erase tempArray
            x = x + 1
        End If
    Next ctrl
GenerateJaggedArrayComboBoxListValues = tempPrimaryArray()
End Function

Sub PrintArray(ByRef ws As Worksheet, ByRef mainArray As Variant)
Dim counter                                             As Long
Dim x                                                   As Long
Dim y                                                   As Long
Dim tempArray()                                         As Variant

    counter = 1
    For x = LBound(mainArray, 1) To UBound(mainArray, 1)
        tempArray = mainArray(x)
        For y = LBound(tempArray, 2) To UBound(tempArray, 2)
            ws.Range("A" & counter) = tempArray(0, y)
            counter = counter + 1
        Next y
    Next x
End Sub

在此处输入图片说明

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