Question

此代码是将“每日现金头寸”文件逐列复制并粘贴到先前记录的“银行回执”文件中。该代码的末尾有两个For循环；第一个以company为代码复制和粘贴，第二个以amount为代码复制和粘贴。该代码可以在第一个For循环中正常工作，但是第二个For循环永远不会执行。谁能帮忙吗？

Sub Geek_Squad_Project()

    Dim FilPicker As FileDialog 
    Dim CashPosition As String
    Dim BankRec As String
    Dim CP As String
    Dim BR As Excel.Workbook
    Dim i As Integer
    Dim c As Integer
    Dim b As Integer
    Dim x As Integer
    Dim d As Integer

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    'assign path with filename in string format to CashPosition and file name in string format to CP

    CashPosition = Application.ActiveWorkbook.FullName
    CP = Application.ActiveWorkbook.Name 

    Set FilPicker = Application.FileDialog(msoFileDialogFilePicker) 

    With FilPicker
        .Title = "Select a daily cash position file"
        .AllowMultiSelect = False
            If .Show <> -1 Then
                GoTo ResetSettings
            '.Show = -1 means the user pressed the action button VS .Show = 0 means the user pressed the cancel button
        'selected file's full path with file name is stored as BankRec
            End If   
        BankRec = .SelectedItems(1)   
    End With

    Set BR = Workbooks.Open(Filename:=BankRec)

    BR.Worksheets("Bank Rec Master").Activate

    'clear filter from Bank Rec

    'If ActiveSheet.AutoFilterMode Then ActiveSheet.ShowAllData  

        If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
            ActiveSheet.ShowAllData
        End If  

    Workbooks(CP).Activate
    Worksheets("Daily Cash Position").Select  

    'save the last row number into c

    c = Cells(Rows.Count, 9).End(xlUp).Row  

    'company code copy and paste

    For i = 1 To c
        If Cells(i, 9) <> "" Then
            Cells(i, 9).Select
            x = Range(Cells(i, 9), Cells(i, 9).End(xlDown)).Count
            Range(Cells(i, 9), Cells(i, 9).End(xlDown)).Copy
            BR.Worksheets("Bank Rec Master").Activate
            b = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(b + 1, 1).PasteSpecial Paste:=xlPasteValues
            i = i + x
        Else
        End If
    Next i

    'amount copy and paste

    For i = 1 To c
        If Cells(i, 10) = "R" Then
            Cells(i, 6).Copy 
            BR.Worksheets("Bank Rec Master").Activate
            d = Cells(Rows.Count, 2).End(xlUp).Row
            Cells(d + 1, 2).PasteSpecial Paste:=xlPasteValues
        ElseIf Cells(i, 10) = "D" Then
            Cells(i, 6).Copy
            BR.Worksheets("Bank Rec Master").Activate
            d = Cells(Rows.Count, 2).End(xlUp).Row
            Cells(d + 1, 2).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
            Cells(d + 1, 2).Value = Cells(d + 1, 2).Value * -1     
        End If
    Next i

    ResetSettings:

    'in case user clicks Cancel 

    Application.ScreenUpdating = True

    Application.EnableEvents = True

    Application.DisplayAlerts = True 

End Sub

Answer 1

Sub Geek_Squad_ProjectII()

Dim FilPicker As FileDialog
Dim CashPosition As String
Dim BankRec As String
Dim CP As Excel.Workbook
Dim BR As Excel.Workbook
Dim i As Integer
Dim c As Integer
Dim b As Integer
Dim x As Integer
Dim d As Integer

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


'assign path with filename in string format to CashPosition and file name in string format to CP


CashPosition = Application.ActiveWorkbook.FullName

Set CP = ActiveWorkbook
Set FilPicker = Application.FileDialog(msoFileDialogFilePicker)

With FilPicker
.Title = "Select a bank rec file"
.AllowMultiSelect = False
    If .Show <> -1 Then
    GoTo ResetSettings

    '.Show = -1 means user pressed the action button VS .Show = 0 means user pressed the cancel button

    'selected file's full path with file name is stored as BankRec

    End If


    BankRec = .SelectedItems(1)

End With


Set BR = Workbooks.Open(Filename:=BankRec)

BR.Worksheets("Bank Rec Master").Activate


'clear filter from Bank Rec


If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then


ActiveSheet.ShowAllData



End If


CP.Activate

Worksheets("Daily Cash Position").Select


'save the last row number into c



c = CP.Worksheets("Daily Cash Position").Cells(Rows.Count, 9).End(xlUp).Row


'company code copy and paste
For i = 1 To c
If IsNumeric(CP.Worksheets("Daily Cash Position").Cells(i, 9)) = True Then
CP.Worksheets("Daily Cash Position").Cells(i, 9).Copy
b = BR.Worksheets("Bank Rec Master").Cells(Rows.Count, 1).End(xlUp).Row
BR.Worksheets("Bank Rec Master").Cells(b + 1, 1).PasteSpecial Paste:=xlPasteValues
Else
End If
Next i



'amount copy and paste
For i = 1 To c
If CP.Worksheets("Daily Cash Position").Cells(i, 10) = "R" Then
CP.Worksheets("Daily Cash Position").Cells(i, 6).Copy
d = BR.Worksheets("Bank Rec Master").Cells(Rows.Count, 9).End(xlUp).Row
BR.Worksheets("Bank Rec Master").Cells(d + 1, 9).PasteSpecial Paste:=xlPasteValues
ElseIf CP.Worksheets("Daily Cash Position").Cells(i, 10) = "D" Then
CP.Worksheets("Daily Cash Position").Cells(i, 6).Copy
d = BR.Worksheets("Bank Rec Master").Cells(Rows.Count, 9).End(xlUp).Row

BR.Worksheets("Bank Rec Master").Cells(d + 1, 9).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats

BR.Worksheets("Bank Rec Master").Cells(d + 1, 9).Value = BR.Worksheets("Bank Rec Master").Cells(d + 1, 9).Value * -1

End If

Next i

ResetSettings:

'in case user clicks Cancel

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub

对于连续未执行的循环

1 个答案: