Код выдает ошибку отладки при запуске - PullRequest
0 голосов
/ 06 августа 2020

Код выдает ошибку отладки, теперь он работал хорошо, я не знаю почему. Может кто-нибудь решить проблему. Все папки и листы имеют то же имя, что и раньше, но ошибка в том, что файлы или расположение были удалены или переименованы. С нетерпением жду вашего ответа.

Этот код работал отлично пару дней назад, но теперь в нем есть ошибка, пожалуйста, обратите внимание на проблему. что это можно исправить

       Public fName As String, _
    fd As FileDialog, _
    wbOne As Workbook, wbTwo As Workbook, tw As Workbook, NewBook1 As Workbook, NewBook2 As Workbook, _
    shOne As Worksheet, shTwo As Worksheet, sh As Worksheet, actOne As Worksheet, actTwo As Worksheet, _
    shResult As Worksheet, actResult_1 As Worksheet, actResult_2 As Worksheet, _
    fChosen As Integer
    Sub ExecuteBtn()
    Dim linkOne As String
    Dim linkTwo As String
    Dim nrRowsOne As Long
    Dim nrRowsTwo As Long
    Dim nrRowsStart As Long
    Dim nrRowsResult1 As Long
    Dim nrRowsResult2 As Long
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set tw = ThisWorkbook
    Set sh = tw.Worksheets("Start")
    nrRowsStart = NrRows(sh, 1)
    
    For j = 2 To nrRowsStart
        fName = sh.Cells(j, 1).Value
        
        linkOne = ThisWorkbook.Path & "\cell are codes\" & fName & ".csv"
        linkTwo = ThisWorkbook.Path & "\Landline Area codes\Landline Area codes Prefixes-" & fName & ".csv"
        
        Set wbOne = Workbooks.Open(linkOne)
        Set actOne = wbOne.Worksheets(1)
        nrRowsOne = NrRows(actOne, 1)
        
        Set wbTwo = Workbooks.Open(linkTwo)
        Set actTwo = wbTwo.Worksheets(1)
        nrRowsTwo = NrRows(actTwo, 1)
    
        nrRowsResult1 = 2
        nrRowsResult2 = 2
        If nrRowsOne <= 1048576 Then
            If nrRowsOne = nrRowsTwo Then
            If nrRowsOne <= 524288 Then AddNew1 (tw.Path & "\Result\Result" & fName & "_1" & ".xlsx")
            If nrRowsOne > 524288 Then AddNew1 (tw.Path & "\Result\Result" & fName & "_1" & ".xlsx"): AddNew2 (tw.Path & "\Result\Result" & fName & "_2" & ".xlsx")
    
                For i = 2 To nrRowsOne
                    If i <= 524288 Then
                        actResult_1.Range("A1:G1").Value = actOne.Range("A1:G1").Value
                        actResult_1.Range("A" & nrRowsResult1 & ":G" & nrRowsResult1).Value = actOne.Range("A" & i & ":G" & i).Value
                        actResult_1.Range("A" & nrRowsResult1 + 1 & ":G" & nrRowsResult1 + 1).Value = actTwo.Range("A" & i & ":G" & i).Value
                        nrRowsResult1 = nrRowsResult1 + 2
                        
                    Else
                        actResult_2.Range("A1:G1").Value = actOne.Range("A1:G1").Value
                        actResult_2.Range("A" & nrRowsResult2 & ":G" & nrRowsResult2).Value = actOne.Range("A" & i & ":G" & i).Value
                        actResult_2.Range("A" & nrRowsResult2 + 1 & ":G" & nrRowsResult2 + 1).Value = actTwo.Range("A" & i & ":G" & i).Value
                        nrRowsResult2 = nrRowsResult2 + 2
                    End If
                Next i
            Else
                MsgBox "The files have different number of rows !", vbCritical
            End If
        Else
            MsgBox "Excel cannot handle more than 1,048,576 rows !", vbCritical
        End If
        If nrRowsOne <= 524288 Then
            NewBook1.SaveAs Filename:=tw.Path & "\Result\Result" & fName & "_1" & ".csv", FileFormat:=xlCSV, CreateBackup:=False
            NewBook1.Close SaveChanges:=False
            Kill (tw.Path & "\Result\Result" & fName & "_1" & ".xlsx")
        End If
        If nrRowsOne > 524288 Then
            NewBook1.SaveAs Filename:=tw.Path & "\Result\Result" & fName & "_1" & ".csv", FileFormat:=xlCSV, CreateBackup:=False
            NewBook1.Close SaveChanges:=False
            Kill (tw.Path & "\Result\Result" & fName & "_1" & ".xlsx")
            
            NewBook2.SaveAs Filename:=tw.Path & "\Result\Result" & fName & "_2" & ".csv", FileFormat:=xlCSV, CreateBackup:=False
            NewBook2.Close SaveChanges:=False
            Kill (tw.Path & "\Result\Result" & fName & "_2" & ".xlsx")
        End If
        wbOne.Close SaveChanges:=False
        wbTwo.Close SaveChanges:=False
        
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    Next j
    MsgBox "Done !", vbInformation
    End Sub
    Sub AddNew1(locationPath As String)
    Set NewBook1 = Workbooks.Add
        With NewBook1
             .SaveAs Filename:=locationPath
            Set actResult_1 = .Worksheets(1)
        End With
    End Sub
    Sub AddNew2(locationPath As String)
    Set NewBook2 = Workbooks.Add
        With NewBook2
            .SaveAs Filename:=locationPath
            Set actResult_2 = .Worksheets(1)
        End With
    End Sub
    Function NrRows(sh As Worksheet, ColNumber As Integer) As Long
        NrRows = sh.Cells(Rows.Count, ColNumber).End(xlUp).row
    End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...