Ошибка @ Выполнение кода в обычном режиме - PullRequest
Новая
       4

Ошибка @ Выполнение кода в обычном режиме

0 голосов
/ 01 сентября 2018

Мой код работает правильно, когда я запускаю его в режиме прерывания, но он не работает, когда я выполняю нормальный запуск!

Почему?! * * 1003

Вот оно: 

Sub ImportBHA()
   'Variables
    Dim Fullpath As String
    Dim oBHA As String 'Opened BHA
    Dim nRange As Integer 'Name Range
    Dim nRows As Integer 'Name Rows
    Dim SheetName As String 'Bitsheet Name
    Dim BookName As String 'Workbook Name


   'Initialization
    BookName = ActiveWorkbook.Name
    SheetName = ActiveSheet.Name

    'Application.ScreenUpdating = False

   'Dialog
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Select the BHA Report"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx", 1
        .Show

        Fullpath = .SelectedItems.Item(1)
    End With

    If InStr(Fullpath, ".xls") = 0 Then
        Exit Sub
    End If

   'Open, Tab & Copy
    Workbooks.Open Fullpath
    oBHA = ActiveWorkbook.Name
    nRange = Workbooks(oBHA).Sheets("BHAReport").Range("C900").End(xlUp).Row

   'Create Temporary Worksheet
    'Workbooks(BookName).Sheets.Add(After:=Workbooks(BookName).Sheets(Workbooks(BookName).Sheets.Count)).Name = "Temp"

       'BHA Name
        Workbooks(oBHA).Sheets("BHAReport").Range("I4").Copy
        Workbooks(BookName).Worksheets(SheetName).Range("AZ60").PasteSpecial xlPasteValues

       'Tools Names
        Workbooks(oBHA).Sheets("BHAReport").Range("D9:D" & nRange + 1).Copy
        Workbooks(BookName).Worksheets(SheetName).Range("AZ65").PasteSpecial xlPasteValues
        'nRows = Workbooks(BookName).Worksheets(SheetName).Range("AZ65:AZ138").Cells.SpecialCells(xlCellTypeConstants).Count
        For I = 65 To (65 + nRange) Step 2
            ActiveSheet.Range("C" & I) = ActiveSheet.Range("AZ" & I)
        Next I

       'Tools Serials
        Workbooks(oBHA).Sheets("BHAReport").Range("F9:F" & nRange + 1).Copy
        Workbooks(BookName).Worksheets(SheetName).Range("AZ65").PasteSpecial xlPasteValues
        For I = 65 To (65 + nRange) Step 2
            ActiveSheet.Range("J" & I) = ActiveSheet.Range("AZ" & I)
        Next I

       'Tools Max OD
        Workbooks(oBHA).Sheets("BHAReport").Range("H9:H" & nRange + 1).Copy
        Workbooks(BookName).Worksheets(SheetName).Range("AZ65").PasteSpecial xlPasteValues
        For I = 65 To (65 + nRange) Step 2
            ActiveSheet.Range("N" & I) = ActiveSheet.Range("AZ" & I)
        Next I

       'Tools OD/ID
        Workbooks(oBHA).Sheets("BHAReport").Range("G9:G" & nRange + 1).Copy
        Workbooks(BookName).Worksheets(SheetName).Range("AZ65").PasteSpecial xlPasteValues
        For I = 65 To (65 + nRange)
            ActiveSheet.Range("Q" & I) = ActiveSheet.Range("AZ" & I)
        Next I

       'Tools Gender
        Workbooks(oBHA).Sheets("BHAReport").Range("K9:K" & nRange + 1).Copy
        Workbooks(BookName).Worksheets(SheetName).Range("AZ65").PasteSpecial xlPasteValues
        For I = 65 To (65 + nRange)
            ActiveSheet.Range("S" & I) = ActiveSheet.Range("AZ" & I)
        Next I

       'Tools Connection Size
        Workbooks(oBHA).Sheets("BHAReport").Range("I9:I" & nRange + 1).Copy
        Workbooks(BookName).Worksheets(SheetName).Range("AZ65").PasteSpecial xlPasteValues
        For I = 65 To (65 + nRange)
            ActiveSheet.Range("T" & I) = ActiveSheet.Range("AZ" & I)
        Next I

       'Tools Connection Type
        Workbooks(oBHA).Sheets("BHAReport").Range("J9:J" & nRange + 1).Copy
        Workbooks(BookName).Worksheets(SheetName).Range("AZ65").PasteSpecial xlPasteValues
        For I = 65 To (65 + nRange)
            ActiveSheet.Range("W" & I) = ActiveSheet.Range("AZ" & I)
        Next I

       'Tools Cum. Lengths
        Workbooks(oBHA).Sheets("BHAReport").Range("N9:N" & nRange + 1).Copy
        Workbooks(BookName).Worksheets(SheetName).Range("AZ65").PasteSpecial xlPasteValues
        For I = 65 To (65 + nRange)
            ActiveSheet.Range("Z" & I) = ActiveSheet.Range("AZ" & I)
        Next I

       'Tools Weights to Temp
        Workbooks(oBHA).Sheets("BHAReport").Range("O9:O" & nRange + 1).Copy
        Workbooks(BookName).Worksheets(SheetName).Range("AZ65").PasteSpecial xlPasteValues
        For I = 65 To (65 + nRange)
            ActiveSheet.Range("AC" & I) = ActiveSheet.Range("AZ" & I)
        Next I

       'Close BHA Sheet
        Workbooks(oBHA).Close savechanges:=False

    'Application.ScreenUpdating = True

End Sub

Это довольно долго, но «импортирует» данные, сгенерированные в отчете электронной таблицы Excel с помощью проприетарного программного обеспечения Schlumberger.

Код копирует некоторые значения из листа отчета на собственный лист сборки донных отверстий!

1 Ответ

0 голосов
/ 01 сентября 2018

Вот пример того, как вы начнете изменять свой код, чтобы правильно ссылаться на объекты Workbooks & Worksheet.

wb = лист в вашей книге, где вы будете запускать макрос из
ib = лист в вашей книге импорта, куда вы будете импортировать значения из

Вам нужно будет обновить имя листа при установке wb на лист, куда будут идти ваши значения. Прямо сейчас оно установлено на Destination Sheet.

Как только вы сделаете это один раз, вам нужно будет обратиться к wb и ib для остальной части вашего кода. Поэтому, когда вы ссылаетесь на диапазон на листе ib BHARReport, просто используйте ib.Range("....") и аналогично для своей основной книги wb.Range("....")

Для конкретного примера вы можете уменьшить ниже: 

Workbooks(oBHA).Sheets("BHAReport").Range("D9:D" & nRange + 1).Copy
Workbooks(BookName).Worksheets(SheetName).Range("AZ65").PasteSpecial xlPasteValues

Кому: 

ib.Range("D9:D" & LRow).Copy
wb.Range("AZ65").PasteSpecial xlPasteValues

в результате значительно легче следовать коду. Это значительно облегчает отладку кода , , поскольку вы действительно можете следить за происходящим. 

Option Explicit

Sub ImportBHA()

Dim wb As Worksheet, ib As Worksheet
Dim LRow As Long, Fullpath as String

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Title = "Select the BHA Report"
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xls; *.xlsx", 1
    .Show
    Fullpath = .SelectedItems.Item(1)
    If .SelectedItems.Count < 1 Then Exit Sub
End With

'Make sure the sheet names are correct here
Set wb = ThisWorkbook.Sheets("Destination Sheet")
Set ib = Workbooks.Open(Fullpath).Sheets("BHARReport")

LRow = ib.Range("C" & ib.Rows.Count).End(xlUp).Offset(1).Row

wb.Range("Az60").Value = ib.Range("I4").Value

ib.Range("D9:D" & LRow).Copy
wb.Range("AZ65").PasteSpecial xlPasteValues
...