VBA говорит «подпрограмма или функция не определена» и выделяет оператор, который должен определять подпрограмму.

Я пытаюсь взять одну ячейку данных из определенных файлов в очень большой папке. В настоящее время у меня есть это:

Sub ExtractDataToDifferentSheets()
    On Error GoTo HandleError
    Application.ScreenUpdating = False
    Dim rowNumber As Integer
    rowNumber = Worksheets("sheet1").UsedRange.rows.Count

    For dRow = 2 To rowNumber
        Dim NG As String
        Dim Lot As String
        NG = Application.Workbooks(1).ActiveSheet.Cells(dRow, 1)
        Lot = Application.Workbooks(1).ActiveSheet.Cells(dRow, 2)
        Dim objectFlieSys As Object
        'Dim objectGetFile As Object
        Dim file As Object
        Set objectFlieSys = CreateObject("Scripting.FileSystemObject")
        Set file = objectFlieSys.GetFile(StringFormat("C:\Users\mmccarthy\Box\QC-QA\SOPS Quality System\Quality logs\Ingredient Release Forms Records\2022 INGREDIENT RELEASE FORM\{0}_{1}.xlsx", NG, Lot))       ' The folder location of the source files.
        Application.Workbooks(1).ActiveSheet.Cells(dRow, 7) = _
               file.Worksheets("Sheet1").Cells(7, 7)
        file.Close False
        Set file = Nothing
    Next
HandleError:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

У меня нет большого опыта работы с VBA, я работал со следующим примером:

Sub ExtractDataToDifferentSheets()
    On Error GoTo HandleError
    Application.ScreenUpdating = False
    Dim rowNumber As Integer
    rowNumber = Worksheets("sheet1").UsedRange.rows.Count

    For dRow = 2 To rowNumber
        Dim NG As String
        Dim Lot As String
        NG = Application.Workbooks(1).ActiveSheet.Cells(dRow, 1)
        Lot = Application.Workbooks(1).ActiveSheet.Cells(dRow, 2)
        Dim objectFlieSys As Object
        'Dim objectGetFile As Object
        Dim file As Object
        Set objectFlieSys = CreateObject("Scripting.FileSystemObject")
        Set file = objectFlieSys.GetFile(StringFormat("C:...\2022 INGREDIENT RELEASE FORM\{0}_{1}.xlsx", NG, Lot))       ' The folder location of the source files.
        Application.Workbooks(1).ActiveSheet.Cells(dRow, 7) = _
               file.Worksheets("Sheet1").Cells(7, 7)
        file.Close False
        Set file = Nothing
    Next
HandleError:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

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

Что особенно сбивает с толку, так это то, что он выделяет первую строку кода, когда выдает ошибку. У меня складывается впечатление, что он говорит мне, что подсистема, которую я пытаюсь определить, не определена. Это было бы глупо. Есть ли в моем коде опечатка, которую я не могу найти? Я понятия не имею, почему предыдущий код запускался, когда этот код немедленно выдает ошибки. это кажется наиболее актуальным вопросом, который я мог найти о переполнении стека, но я не могу найти «создать», на который ссылается ответ.

Пожалуйста, помогите, иначе я проведу все выходные вручную копируя данные для этой невероятно простой задачи. :(

What is especially confusing is it highlights the first line of code - да, в желтом. Он также выделяет что-то еще синим цветом. Ты это видишь?
GSerg 18.11.2022 23:23
vitoshacademy.com/…
Tim Williams 18.11.2022 23:37
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
0
2
50
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Настоятельно рекомендуется включить Option Explicit при написании файла marco. (Находится в VBA-> Инструменты-> Вкладка «Редактор»-> Требовать объявление переменной).

Это заставит вас определить (Dim) ваши строки, переменные, рабочие книги, имена листов и т. д.

Я бы проверил, что "лист1" не должен быть заглавной буквой S "Лист1"

В качестве альтернативы, изменение («лист1») на просто (1) пометит первый лист в этой книге.

Например.

rowNumber = Рабочие листы("лист1").UsedRange.rows.Count

станет

rowNumber = Рабочие листы (1).UsedRange.rows.Count

Я ценю вашу помощь, но я не уверен, какую строку мне не удалось определить? у меня нет определенных строковых переменных, которые я вижу, только строка, возвращаемая функцией string.format. Нужно ли мне определить это как именованную переменную, а затем передать ее другой функции?

DumDumDumDumDum 21.11.2022 18:41
Ответ принят как подходящий

Импорт данных из закрытых книг

Option Explicit

Sub ImportData()
    Dim IsSuccess As Boolean
    On Error GoTo ClearError
        
    ' Define constants.
    
    Const SOURCE_SUBFOLDER_PATH As String _
        = "Box\QC-QA\SOPS Quality System\Quality logs" _
        & "\Ingredient Release Forms Records\2022 INGREDIENT RELEASE FORM"
    Const SOURCE_FILE_EXTENSION As String = ".xlsx"
    Const NG_LOT_DELIMITER As String = "_"
    
    ' Build the Source folder path.
    
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim SourceFolderPath As String: SourceFolderPath _
        = fso.BuildPath(Environ("USERPROFILE"), SOURCE_SUBFOLDER_PATH)
    If Not fso.FolderExists(SourceFolderPath) Then
        MsgBox "The folder '" & SourceFolderPath & "' doesn't exist.", _
            vbExclamation
        Exit Sub
    End If
    
    ' Destination
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets("Sheet1")
    Dim dlRow As Long: dlRow = dws.UsedRange.Rows.Count
    
    ' Copy.
    
    Application.ScreenUpdating = False
    
    Dim swb As Workbook
    Dim sws As Worksheet
    Dim SourceFileName As String
    Dim SourceFilePath As String
    Dim NG As String
    Dim Lot As String
    Dim dRow As Long

    For dRow = 2 To dlRow
        ' Build the Source file path.
        NG = CStr(dws.Cells(dRow, "A").Value)
        Lot = CStr(dws.Cells(dRow, "B").Value)
        SourceFileName = NG & NG_LOT_DELIMITER & Lot & SOURCE_FILE_EXTENSION
        SourceFilePath = fso.BuildPath(SourceFolderPath, SourceFileName)
        If fso.FileExists(SourceFilePath) Then ' file found
            ' Open, copy and close.
            Set swb = Workbooks.Open(SourceFilePath, True, True)
            Set sws = swb.Worksheets("Sheet1")
            dws.Cells(dRow, "G").Value = sws.Range("G7").Value
            swb.Close SaveChanges:=False
        Else ' file not found
            'dws.Cells(dRow, "G").ClearContents
        End If
    Next dRow

    IsSuccess = True

ProcExit:
    On Error Resume Next
        If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
        If IsSuccess Then
            MsgBox "Data imported.", vbInformation
        Else
            MsgBox "Something went wrong.", vbCritical
        End If
    On Error GoTo 0
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "':" & Err.Description
    Resume ProcExit
End Sub

Спасибо, это в основном работает, и я думаю, что любые незаполненные данные - это просто проблема с моим набором данных. Это намного сложнее, чем я думал! мне придется просмотреть его в глубину, чтобы лучше понять.

DumDumDumDumDum 21.11.2022 18:37

Другие вопросы по теме