Question

我正在尝试创建一个包含两个数据范围的所有可能组合的矩阵。第一范围是过滤数据并且基于用户的所选范围（可以是零到300行）而变化，并且第二范围是19000行，53列数据的列表。首先尝试，我写了一个根本没用的代码。未完成的代码（不包括清除最后结果的部分）如下所示。

Sub Submitnew()
'
' Submitnew Macro
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
Sheets("Hidden").Visible = True

'  1 - Filter data on TireSelect sheet. Do not change this part of code
Sheets("TireSelect").Select
ActiveSheet.Range("$A$1:$I$2").AutoFilter Field:=2, Criteria1:="550"
ActiveSheet.ShowAllData
Range("N4:W4").Select
Selection.Copy
Range("N3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1:I500000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("N2:W3"), Unique:=False

' 2- Create the input sheet
'2-1- Select the desired filtered data
    Sheets("TireSelect").Select
    Range("B2:F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Hidden").Select
    Range("A2").Select
    ActiveSheet.Paste
'2-2- Set last row variables
    Dim rr, i, j, lr1, lr2 As Integer
    lr1 = Cells(1000, "A").End(xlUp).Row
    lr2 = 19684
'2-3- Create a loop
    rr = 2
    For i = 2 To lr1
    For j = 2 To lr2

    'Green cells
        Sheets("Hidden").Select
        Range(Cells(i, "A"), Cells(i, "E")).Select
        Selection.Copy
        Sheets("Input Matrix").Select
        Cells(rr, "E").Select
        Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'Other values
        Sheets("Hidden").Select
        Range(Cells(j, "F"), Cells(j, "BC")).Select
        Selection.Copy
        Sheets("Input Matrix").Select
        Cells(rr, "J").Select
        Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    rr = rr + 1
    Next j
    Next i

Sheets("Hidden").Visible = False

End Sub

如何以有效的方式编写此代码？似乎我应该尽可能地消除for循环，但我是VBA的新手，并且对其他可能的方式不太了解。我很感激你的建议。

Excel VBA-如何生成没有for循环的1000000结果列表？

0 个答案: