Excel VBA for循环和插入结果

时间:2015-07-30 05:33:40

标签: vba loops for-loop insert row

如果某个条件满足,我创建了一个VBA应用程序将结果提取到另一个工作表,并插入一个空行,然后下一个提取下一个结果。我的VBA只提取第一个结果而不是继续,任何人都可以帮忙吗?

    Option Explicit
    Sub ClearCustomer()

    Dim i As Variant, j As Variant, k As Variant
    Dim LastRow As Long
    Dim LastRow2 As Long
    Dim LastRow3 As Long
    Dim aFile As String
    Dim wb As Workbook
    Dim wshell
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim diff As Double
    Const tolerance As Long = 100

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    aFile = ThisWorkbook.Path & "\FBL5N.XLSX"
         If Len(Dir$(aFile)) > 0 Then
         Kill aFile

    End If

    Set wshell = CreateObject("WScript.Shell")
    wshell.Run Chr(34) & "C:\Users\nxkan\Desktop\AUTO\FBL5N.vbs" & Chr(34), 1, 1

    On Error Resume Next
    Workbooks.Open Filename:=ThisWorkbook.Path & "\FBL5N.XLSX"

    Set wb = Workbooks("FBL5N.XLSX")

    Set ws = wb.Sheets("Sheet1")

    ws.Range("A:C,E:F,I:I,L:L").EntireColumn.Delete

    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "FBL5N"

    Set ws1 = wb.Sheets("FBL5N")

    LastRow = ws.Range("F" & Rows.Count).End(xlUp).Row
    LastRow2 = ws.Range("G" & Rows.Count).End(xlUp).Row
    LastRow3 = ws1.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LastRow
              For j = 2 To LastRow2
                          For k = 1 To LastRow3
                          If ws.Cells(i, 6).Value = ws.Cells(j, 7).Value Then
                                             diff = Application.WorksheetFunction.SumIf(ws.Range(ws.Cells(2, 6), ws.Cells(i, 6)), ws.Cells(i, 6), ws.Range(ws.Cells(2, 4), ws.Cells(i, 4))) + Application.WorksheetFunction.SumIf(ws.Range(ws.Cells(2, 7), ws.Cells(j, 7)), ws.Cells(j, 7), ws.Range(ws.Cells(2, 4), ws.Cells(j, 4)))


                        If diff <= tolerance And diff >= -tolerance Then

                        ws1.Cells(k, 1).Value = ws.Cells(i, 1).Value
                        ws1.Cells(k, 2).Value = ws.Cells(i, 2).Value
                        ws1.Cells(k, 3).Value = ws.Cells(i, 3).Value
                        ws1.Cells(k, 4).Value = ws.Cells(i, 4).Value
                        ws1.Cells(k, 5).Value = ws.Cells(i, 5).Value
                        ws1.Cells(k, 6).Value = ws.Cells(i, 6).Value
                        ws1.Cells(k, 7).Value = ws.Cells(i, 7).Value

                        ws1.Cells(k + 1, 1).Value = ws.Cells(j, 1).Value
                        ws1.Cells(k + 1, 2).Value = ws.Cells(j, 2).Value
                        ws1.Cells(k + 1, 3).Value = ws.Cells(j, 3).Value
                        ws1.Cells(k + 1, 4).Value = ws.Cells(j, 4).Value
                        ws1.Cells(k + 1, 5).Value = ws.Cells(j, 5).Value
                        ws1.Cells(k + 1, 6).Value = ws.Cells(j, 6).Value
                        ws1.Cells(k + 1, 7).Value = ws.Cells(j, 7).Value

                        Exit For
                    End If
                 End If
              k = k + 3
           Next k
       Next j
   Next i

    'With ActiveSheet
            '.AutoFilterMode = False
            '.Range("A1:K1").AutoFilter Field:=7, Criteria1:="<>"
    'End With

    MsgBox "Finished"

    End Sub

0 个答案:

没有答案