Question

我是新手使用数组（和一般的VBA），我正在尝试将一系列数组合并到一个模块中，该模块在单个工作簿的工作表中格式化SPSS语法输出。下面是我的代码，它有效，但是复制了找到的结果。我认为这与我的循环顺序有关，但我似乎无法弄清楚如何解决它。任何想法都将不胜感激。

Sub FindValues()

Call CreateSummary

'This code will build the initial summary file

    Dim ws As Excel.Worksheet

    'Application.ScreenUpdating = False

    MsgBox ("It will take a moment for data to appear, please be patient if data does not immediately appear")

    Dim LastRow As Long
    Dim i As Integer
    Dim i2 As Integer
    Dim x As Integer
    Dim y As Integer
    Dim CopiedRows As Integer
    Dim LocationA(4) As String
    Dim LocationB(4) As String
    Dim LocationC(4) As String
    Dim LocationD(4) As String
    Dim VariableA(4) As Integer
    Dim VariableB(4) As Integer
    Dim ColumnA(4) As String
    Dim ColumnB(4) As String
    Dim n As Long

    'Find DateTime Info
    LocationA(1) = "Date_Time"
    LocationB(1) = "Quarter"
    LocationC(1) = "N"
    LocationD(1) = "Minimum"
    VariableA(1) = 1
    VariableB(1) = 1
    ColumnA(1) = "B"
    ColumnB(1) = "C"

    LocationA(2) = "Dur*"
    LocationB(2) = "Methodology_ID"
    LocationC(2) = "Mean"
    LocationD(2) = "N"
    VariableA(2) = 1
    VariableB(2) = 1
    ColumnA(2) = "C"
    ColumnB(2) = "D"

    LocationA(3) = "WebTimeout"
    LocationB(3) = "Methodology_ID"
    LocationC(3) = "Mean"
    LocationD(3) = "N"
    VariableA(3) = 1
    VariableB(3) = 1
    ColumnA(3) = "C"
    ColumnB(3) = "D"

    'LocationA(4) = "Crosstabulation"
    'LocationB(4) = "Quarter"
    'LocationC(4) = "N"
    'LocationD(4) = "Minimum"
    'VariableA(4) = 1

    'Find OSAT Data
    'LocationA(2) = "*Report*"
    'LocationB(2) = "*CallMonth*"
    'LocationC(2) = "Mean*"
    'LocationD(2) = "*Overall*"
    'VariableA(2) = 2

    For Each ws In Application.ThisWorkbook.Worksheets
    'Starting row
    i = 1
    'Find LastRow
    LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

    If ws.Name <> "Run Macros" Then

        Do While i <= LastRow
            For x = 1 To 3

            If ws.Range("A" & i).Value Like LocationA(x) And ws.Range("A" & i + 1).Value Like LocationB(x) And ws.Range(ColumnA(x) & i + VariableA(x)).Value Like LocationC(x) And ws.Range(ColumnB(x) & i + VariableB(x)).Value Like LocationD(x) Then
            CopiedRows = 0
            i2 = i

                Do While ws.Range("A" & i2 + 1).Borders(xlEdgeLeft).LineStyle = 1 And ws.Range("A" & i2 + 1).Borders(xlEdgeLeft).Weight = 4
                i2 = i2 + 1
                CopiedRows = CopiedRows + 1
                Loop
                n = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 4
                ws.Rows(i & ":" & i + CopiedRows).Copy Sheets("Summary").Range("A" & n)
            On Error Resume Next
            End If
            Next x
            i = i + 1
        Loop
    End If
    Next

    'Application.ScreenUpdating = True

End Sub

Answer 1

如果有人想重复使用此代码，这是有效的。

  For x = 1 To 3 Step 1
            For Each ws In Application.ThisWorkbook.Worksheets
                'Starting row
                i = 1
                'Find LastRow
                LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
                Do While i <= LastRow
                    If ws.Name <> "Run Macros" Or ws.Name <> "Summary" Then
                    If ws.Range("A" & i).Value Like LocationA(x) And ws.Range("A" & i + 1).Value Like LocationB(x) And ws.Range(ColumnA(x) & i + VariableA(x)).Value Like LocationC(x) And ws.Range(ColumnB(x) & i + VariableB(x)).Value Like LocationD(x) Then
                        CopiedRows = 0
                        i2 = i
                        Do While ws.Range("A" & i2 + 1).Borders(xlEdgeLeft).LineStyle = 1 And ws.Range("A" & i2 + 1).Borders(xlEdgeLeft).Weight = 4
                        i2 = i2 + 1
                    CopiedRows = CopiedRows + 1
                    Loop
                        n = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 4
                        ws.Rows(i & ":" & i + CopiedRows).Copy Sheets("Summary").Range("A" & n)
                        Exit For
                        On Error Resume Next
                    End If
                    End If
                i = i + 1
                Loop
            Next
        Next x

VBA循环与数组重复输出

1 个答案: