3

問題を解決する方法を見つけようとしましたが、できませんでした。ある Excel ファイルから別の Excel ファイルに情報をインポートするコードを見つけました。シートの命名と列の番号付けをやり直しましたが、実行しようとすると、「エラー #1004: アプリケーション定義またはオブジェクト定義のエラーです。マクロは停止します」というエラーが表示されました。それを手伝ってくれませんか？

Private Sub CommandButton1_Click()
On Error GoTo errorhandler
Dim ThisWorkbook As Workbook
Dim ws As Worksheet
Dim RngFleetData, rng As Range
Dim x As Variant
Dim countryN, counnty As String

Dim lReadFirstRow As Long
Dim lReadLastRow As Long
Dim lWriteFirstRow As Long
Dim lWriteLastRow As Long
Dim iRow As Integer
Dim NumOfMonth As Double
filenev = ActiveWorkbook.Name
Application.Calculation = xlCalculationManual
NRRowsRange = 1

 x = Application.GetOpenFilename("Excel Spreadsheets ,*.xls*", , "Open File")
If x = False Then
    Exit Sub
End If

Set ThisWorkbook = Workbooks.Open(x, False, True)

ThisWorkbook.Worksheets("Sheet1").Unprotect

 copied = 0

 j = 1
 Do While Workbooks(filenev).Sheets("auto").Cells(j, 1) <> "fields extract"
 j = j + 1
 Loop
 j = j + 3

 i = 0
 Do While ThisWorkbook.Worksheets("Sheet1").Cells(i, 3) <> ""
    If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1) <> 0 Then

        Workbooks(filenev).Sheets("auto").Cells(j, 1) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 3)
        Workbooks(filenev).Sheets("auto").Cells(j, 2) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 12)
        Workbooks(filenev).Sheets("auto").Cells(j, 3) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 13)
        Workbooks(filenev).Sheets("auto").Cells(j, 4) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 16)
        Workbooks(filenev).Sheets("auto").Cells(j, 5) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 19)
        Workbooks(filenev).Sheets("auto").Cells(j, 6) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 20)
        Workbooks(filenev).Sheets("auto").Cells(j, 7) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 22)
        Workbooks(filenev).Sheets("auto").Cells(j, 8) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 23)
        Workbooks(filenev).Sheets("auto").Cells(j, 9) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 24)
        Workbooks(filenev).Sheets("auto").Cells(j, 10) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 25)
        Workbooks(filenev).Sheets("auto").Cells(j, 11) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 26)
        Workbooks(filenev).Sheets("auto").Cells(j, 12) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 27)
        Workbooks(filenev).Sheets("auto").Cells(j, 13) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 28)
        Workbooks(filenev).Sheets("auto").Cells(j, 14) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 32)
        Workbooks(filenev).Sheets("auto").Cells(j, 15) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 33)
        Workbooks(filenev).Sheets("auto").Cells(j, 16) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 34)
        Workbooks(filenev).Sheets("auto").Cells(j, 17) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 35)
        Workbooks(filenev).Sheets("auto").Cells(j, 18) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 11)


    If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1) = "" Then Workbooks(filenev).Sheets("auto").EntireRow.Delete
       If ThisWorkbook.Worksheets("Sheet1").Cells(i, 2) = 0 Then Workbooks(filenev).Sheets("auto").EntireRow.Delete
       Application.Goto Workbooks(filenev).Sheets("auto").Cells(j, 1)
       ActiveCell.Rows(NRRowsRange).EntireRow.Select
       Selection.Copy
       Selection.Insert Shift:=xlDown
       copied = 1



j = j + 1
End If
i = i + 1
Loop

If copied = 1 Then
ActiveCell.Rows(NRRowsRange).EntireRow.Select
Selection.Delete
Selection.Insert Shift:=xlUp
End If

Application.DisplayAlerts = False
ThisWorkbook.Close False
Application.DisplayAlerts = True


MsgBox "fields has been imported sucessfully!"

  Application.Calculation = xlCalculationAutomatic
Workbooks(filenev).Sheets("auto").Activate

errorhandler:
Select Case Err.Number
Case 9
MsgBox "Hey Buddy, this is NOT the right extract! Macro will STOP", vbExclamation, "STOP"
ThisWorkbook.Close False
Case 0
Case Else
MsgBox "Error # " & Err & " : " & Error(Err) & "Macro will STOP"
End Select
End Sub

前もって感謝します！

4

1 に答える 1

2

この行にエラーが表示されます

 i = 0
 Do While ThisWorkbook.Worksheets("Sheet1").Cells(i, 3) <> ""

最初の行は0

に変更i = 0してi = 1、再試行してください。

これらの行にもエラーが表示されます

If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1) = "" Then Workbooks(filenev).Sheets("auto").EntireRow.Delete
If ThisWorkbook.Worksheets("Sheet1").Cells(i, 2) = 0 Then Workbooks(filenev).Sheets("auto").EntireRow.Delete

どの行を削除しますか? 行に言及する必要があります。例えば

Workbooks(filenev).Sheets("auto").Rows(1).Delete

編集

申し訳ありませんが、このアドバイスをせずにはいられませんでした。私が指摘するだろうと思ったいくつかのことに気づきました

A. _ useOption Explicitこれにより、すべての変数を確実に宣言できます。では、なぜこれが重要なのでしょうか。使う理由は主に2つOption Explicit

a)。変数を特定のデータ型として宣言する必要があります。

b)。変数を入力するときに発生する可能性のあるスペルミスをチェックするコードを監視します。

これも読みたいですか？

B適切な取り扱いをしてください。これは、エラーをトラップできるようにするために必要であり、「デフォルトの復元」は言うまでもありません

たとえば、Application.Calculation = xlCalculationManualエラーが発生した場合はどうなりますか? を設定しています。私はこのようなものをお勧めします

Option Explicit

Private Sub Sample()
    Dim clc As Long

    On Error GoTo errorhandler

    clc = Application.Calculation

    Application.Calculation = xlCalculationManual

    '
    '~~> REST OF YOUR CODE
    '

LetsContinue:
    Application.Calculation = clc '<~~ Reset Calc
    Exit Sub
errorhandler:
    Select Case Err.Number
    Case 9
        MsgBox "Hey Buddy, this is NOT the right extract! Macro will STOP", vbExclamation, "STOP"
        ThisWorkbook.Close False
    Case Else
        MsgBox "Error # " & Err & " : " & Error(Err) & "Macro will STOP"
    End Select
    Resume LetsContinue
End Sub
于 2013-01-21T10:25:29.020 に答える