0

ファイル内の生データを取得し、レポートの「日付」に基づいてデータを要約し、この要約されたデータを「日付」の値に従ってターゲット ワークブックにコピーするコードを作成しました。

このコードを実行しようとしたとき。あるファイルでは問題なく動作しますが、別のファイルではハングアップします。デバッグしようとすると、コードの流れをたどることができません。それは突然壊れます。この問題を解決するのを手伝ってもらえますか?

Option Explicit
Sub file_select()
Dim RequiredFileName As Variant, i As Integer
Dim targetWorkbook As Workbook
' making weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook
'RequiredFileName = "c:\myfiles\test.xls"
On Error GoTo EndNow
RequiredFileName = Application.GetOpenFilename(FileFilter:="ALL Files (*.*), *.*", Title:="Get File", MultiSelect:=True)
For i = 1 To UBound(RequiredFileName)
    MsgBox RequiredFileName(i), , GetFileName(CStr(RequiredFileName(i)))
Next i
For i = 1 To UBound(RequiredFileName)
    Call ProcessOpenFile(RequiredFileName(i), targetWorkbook)
Next i
EndNow: End Sub

Function GetFileName(filespec As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
GetFileName = fso.GetFileName(filespec)
End Function

Sub ProcessOpenFile(RequiredFileName, targetWorkbook As Workbook)
Dim RequiredWorkbook As Workbook
'Dim targetWorkbook As Workbook
' get the required workbook
Set RequiredWorkbook = Application.Workbooks.Open(RequiredFileName)

Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets("Summary_NV")
Dim RequiredSheet As Worksheet
Set RequiredSheet = RequiredWorkbook.Sheets(1)        'here assumed that source workbook consists only of one sheet i.e., is the required sheet.
RequiredWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
RequiredWorkbook.Sheets(Sheets.Count).Select
RequiredWorkbook.Sheets(Sheets.Count).Name = "SUMMARY" & Sheets.Count
Call Sort_Before(RequiredWorkbook)        'sorting the required file data according to date.

If RequiredSheet.Name = "EVDO_SC_Summary" Then
    Call ProcessEVDO(RequiredSheet)        'get the summary of report
    Call Sort_After(RequiredWorkbook)        ' sort the summary according to date
    Call DateChange(RequiredWorkbook)        'changing date format
ElseIf RequiredSheet.Name = "CDMAVoice_SC_Summary" Then
    Call ProcessVoice(RequiredSheet)
    Call Sort_After(RequiredWorkbook)
    Call DateChange(RequiredWorkbook)
ElseIf RequiredSheet.Name = "CDMAData_SC_Summary" Then
    Call ProcessData(RequiredSheet)
    Call Sort_After(RequiredWorkbook)
    Call DateChange(RequiredWorkbook)
End If

Dim iRow As Integer
Dim LastRow_Req As Integer
Dim LastRow_Tar As Integer
Dim LastCol_Req As Integer
LastRow_Req = RequiredWorkbook.Sheets(Sheets.Count).Cells(Rows.Count, 1).End(xlUp).Row        'last row summary data
LastCol_Req = RequiredWorkbook.Sheets(Sheets.Count).Cells(1, Columns.Count).End(xlToLeft).Column        'last column of summary data
LastRow_Tar = targetSheet.Cells(Rows.Count, 1).End(xlUp).Row        'last row of target sheet used
RequiredWorkbook.Sheets(Sheets.Count).Range("B1").Resize(LastRow_Req, LastCol_Req - 1).Select        'selecting summary data for copying
Selection.Copy

If targetSheet.Cells(LastRow_Tar, 1).Value < RequiredWorkbook.Sheets(Sheets.Count).Range("A1").Value Then        'if date entered in target sheet last cell is less
    If RequiredWorkbook.Sheets(1).Name = "EVDO_SC_Summary" Then        'then the summary report date
        targetSheet.Activate
        Cells(LastRow_Tar + 1, 16).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                      :=False, Transpose:=False
        Cells(LastRow_Tar + 1, 1).Select
        Call Date_update(RequiredWorkbook, targetWorkbook, LastRow_Tar + 1, 1)
    ElseIf RequiredWorkbook.Sheets(1).Name = "CDMAVoice_SC_Summary" Then
        targetSheet.Activate
        Cells(LastRow_Tar + 1, 2).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                      :=False, Transpose:=False
        Cells(LastRow_Tar + 1, 1).Select
        Call Date_update(RequiredWorkbook, targetWorkbook, LastRow_Tar + 1, 1)
    ElseIf RequiredWorkbook.Sheets(1).Name = "CDMAData_SC_Summary" Then
        targetSheet.Activate
        Cells(LastRow_Tar + 1, 9).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                      :=False, Transpose:=False
        Cells(LastRow_Tar + 1, 1).Select
        Call Date_update(RequiredWorkbook, targetWorkbook, LastRow_Tar + 1, 1)
    End If
End If

For iRow = targetSheet.Range("A12").Row To LastRow_Tar
    RequiredWorkbook.Activate
    If targetSheet.Cells(iRow, 1).Value < RequiredWorkbook.Sheets(Sheets.Count).Range("A1").Value Then
        GoTo A
    ElseIf targetSheet.Cells(iRow, 1).Value = RequiredWorkbook.Sheets(Sheets.Count).Range("A1").Value Then
        If RequiredWorkbook.Sheets(1).Name = "EVDO_SC_Summary" Then
            targetSheet.Activate
            Cells(iRow, 16).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                          :=False, Transpose:=False
            Cells(iRow, 1).Select
            Call Date_update(RequiredWorkbook, targetWorkbook, iRow, 1)
            Exit For
        ElseIf RequiredWorkbook.Sheets(1).Name = "CDMAVoice_SC_Summary" Then
            targetSheet.Activate
            Cells(iRow, 2).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                          :=False, Transpose:=False
            Cells(iRow, 1).Select
            Call Date_update(RequiredWorkbook, targetWorkbook, iRow, 1)
            Exit For
        ElseIf RequiredWorkbook.Sheets(1).Name = "CDMAData_SC_Summary" Then
            targetSheet.Activate
            Cells(iRow, 9).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                          :=False, Transpose:=False
            Cells(iRow, 1).Select
            Call Date_update(RequiredWorkbook, targetWorkbook, iRow, 1)
            Exit For
        End If
    ElseIf targetSheet.Cells(iRow, 1).Value > RequiredWorkbook.Sheets(Sheets.Count).Range("A1").Value Then
        If RequiredWorkbook.Sheets(1).Name = "EVDO_SC_Summary" Then
            targetSheet.Activate
            Cells(iRow, 16).Select
            Selection.Insert Shift:=xlDown
            Exit For
            Cells(iRow, 1).Select
            Call Date_update(RequiredWorkbook, targetWorkbook, iRow, 1)
        ElseIf RequiredWorkbook.Sheets(1).Name = "CDMAVoice_SC_Summary" Then
            targetSheet.Activate
            Cells(iRow, 2).Select
            Selection.Insert Shift:=xlDown
            Cells(iRow, 1).Select
            Call Date_update(RequiredWorkbook, targetWorkbook, iRow, 1)
            Exit For
        ElseIf RequiredWorkbook.Sheets(1).Name = "CDMAData_SC_Summary" Then
            targetSheet.Activate
            Cells(iRow, 9).Select
            Selection.Insert Shift:=xlDown
            Cells(iRow, 1).Select
            Call Date_update(RequiredWorkbook, targetWorkbook, iRow, 1)
            Exit For
        End If
    End If
A:     Next
RequiredWorkbook.Close savechanges:=False
End Sub
4

1 に答える 1

0

「コードが無限ループに陥っている」というコメントで回答 – user1806794

于 2015-03-14T22:54:29.467 に答える