Импорт данных из трех файлов xls на три листа

#excel #vba

Вопрос:

Я хочу импортировать данные из трех файлов .xls в три листа.

У меня есть форма пользователя со следующим сценарием:

 Private Sub Button_SelectFile_Click()
    
    SelectedFile = Application.GetOpenFilename(fileFilter:="Excel-Dateien (*.xls; *.xlsm; *.xlsx),*.xls; *.xlsm; *.xlsx", Title:="Bitte SAP-Export-Datei auswählen", MultiSelect:=True)
    
    If VarType(SelectedFile) = vbBoolean Then
        If SelectedFile = False Then
            Auswertung.Label_SelectedFile.Caption = "Ausgewählte Dateien: Keine"
            Exit Sub
        End If
    Else
        Auswertung.Label_SelectedFile.Caption = "Ausgewählte Dateien: " amp; Join(SelectedFile, "; ")
    End If
End Sub

Private Sub Button_Start_Click()
     
    Dim Box
    
    If VarType(SelectedFile) = vbEmpty Then
        Box = MsgBox("Bitte wählen Sie mindestens eine Datei aus.", vbOKOnly, "Keine Datei ausgewählt")
        If Box = vbOK Then
            Exit Sub
        End If

    Else
        Box = MsgBox("Möchten Sie das Programm starten?", vbOKCancel)
        If Box = vbOK Then
            'Starten'
            Call Generate_Database(SelectedFile)
        Else
            Exit Sub
        End If
    End If
    
End Sub
 

Я хочу использовать подраздел «Generate_Database(выбранный файл)», чтобы получить данные из трех файлов на трех листах.

Комментарии:

1. Я полагаю, что SelectedFile переменная объявлена ( As Variant ) поверх модуля кода формы (в области объявлений). Это правда? Если да, то «импортировать данные из 3 разных файлов .xls в 3 конкретных листа» недостаточно для создания необходимого Sub , о котором вы просите. Что делать, если вы выберете только два таких файла или 5? Есть ли в каждой обсуждаемой рабочей книге только один лист? Если нет, то какой лист следует скопировать? Вам нужно также скопировать формат листа?

2. Должна ли предполагаемая «база данных» быть новой рабочей книгой? Если да, следует ли его где — нибудь сохранить? Если да, то где? Что означает «3 конкретных листа»? Должны ли они получить конкретное имя? Если да, то откуда его брать?

3. Привет, спасибо за ваш ответ. Да, я использовал Option Explicit Public SelectedFile As Variant . В каждой рабочей книге есть только один лист. Имя книги совпадает с именем Листа. Я хочу выбрать только 3 или меньше. Пример данные из Workbook1 должны попасть в существующий лист Workbook1 и так далее. Формат для меня не имеет значения. Я надеюсь, что это немного прояснит ситуацию.

4. Вы не ответили на уточняющий вопрос, связанный с рабочей книгой, в которую необходимо скопировать три листа… Следует ли его создавать? Разве это не должно быть спасено? Если будет выбрано более 3 таких книг, что делать? Должен ли код копироваться только с первых трех из них? Должно ли это быть связано с ограничением числа, превышающим 3? Или что?

5. Три листа из трех рабочих книг должны быть скопированы на три уже существующих листа. Если выбрано более 3 книг, то система должна выдать сообщение об ошибке типа Box = MsgBox("You can only select 3 Workbooks", vbOKCancel) и вообще не запускаться.

Ответ №1:

Пожалуйста, попробуйте следующий код:

 Sub Generate_Database(arrWb As Variant)
   Dim El, wb As Workbook, wbCopy As Workbook
   Dim shP As Worksheet, shName As String, arrC
   
   If Not IsArray(arrWb) Then Exit Sub
   If UBound(arrWb) > 3 Then MsgBox _
          "Too many workbooks selected (" amp; UBound(arrWb)   1 amp; ") instead of maximum 3...": Exit Sub
   Set wb = ThisWorkbook

   For Each El In arrWb
        Set wbCopy = Workbooks.Open(El)
        shName = Split(Right(El, Len(El) - InStrRev(El, "")), ".")(0) 'extract the sheet name from wb name
        arrC = wbCopy.Sheets(1).UsedRange.Value
        On Error Resume Next
         Set shP = ThisWorkbook.Sheets(shName)
         If err Then
            err.Clear: On Error GoTo 0
            MsgBox "Not possible to find the sheet named " amp; shName amp; "...": Exit Sub
         End If
        On Error GoTo 0
        With shP.Range("A1").Resize(UBound(arrC), UBound(arrC, 2))
                .Value = arrC
                .EntireColumn.AutoFit
        End With
        wbCopy.Close False
   Next
End Sub
 

Комментарии:

1. Большое вам спасибо. Извините за мои плохие навыки объяснения. Я стараюсь сделать это лучше с самого начала, когда в следующий раз мне понадобится помощь. Это именно то, чего я хотел.

2. @Nelina Рада, что я (наконец-то) смогла помочь! Хорошо понимать, что то, как вы описываете проблему в своем вопросе, важно для того, чтобы мы знали, что вам действительно нужно. Даже будучи программистом (не в моем случае), обязательно иметь план, основанный на том, что нужно разработать фрагмент кода. Без необходимых разъяснений я не думаю, что кто-то, желающий помочь, мог бы сделать слишком много…