Страницы: 1
RSS
Добавление столбца и заполнение его значением из ячейки не в таблице
 
.
Изменено: Евгений Валерьевич - 04.06.2022 15:32:50
 
Вариант макросом для самой светлой головы нашей с вами современности. ...Новосельцева разумеется )
Код
Sub СобратьФайлы()
    Dim fileList As Variant
    fileList = ShowFileDialog()
    If IsEmpty(fileList) Then Exit Sub
    
    Application.EnableEvents = False
    Dim Application_Calculation As Long
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual
    
    Dim wb As Workbook
    Set wb = GetWb(fileList(1))
    Dim sh As Worksheet
    Set sh = wb.Sheets(1)
    
    With sh
        .Rows("13:" & .UsedRange.Row + .UsedRange.Rows.Count - 1).Clear
    End With
    
    Dim ifile As Long
    For ifile = 1 To UBound(fileList)
        CopyFromFileToSheet fileList(ifile), sh
    Next
    
    sh.Rows("3:11").ClearContents
    
    Application.Calculation = Application_Calculation
    Application.EnableEvents = True
    
End Sub

Private Sub CopyFromFileToSheet(ByVal sfile As String, sh As Worksheet)
    Dim wb As Workbook
    Set wb = Workbooks.Open(sfile, False, True)
    With wb.Sheets(1)
        Dim rt As Range
        Dim rf As Range
        Set rf = Intersect(.UsedRange, .Range(.Cells(13, 1), .Cells(.Rows.Count, .Columns.Count)))
        If Not rf Is Nothing Then
            With sh
                Set rt = .Cells(.UsedRange.Row + .UsedRange.Rows.Count, 1)
            End With
            Dim sklad As String
            sklad = GetSklad(.Range("A1:B11"))
            rf.Columns(rf.Columns.Count).Value = sklad
            rf.Copy rt
        End If
    End With
        
    wb.Close False
End Sub

Private Function GetSklad(rn As Range) As String
    On Error Resume Next
        GetSklad = WorksheetFunction.VLookup("Склад:", rn, 2, 0)
    On Error GoTo 0
End Function

Private Function GetWb(ByVal sampleFullName As String) As Workbook
    Dim wb As Workbook
    Set wb = Workbooks.Open(sampleFullName, False, True)
    wb.Sheets(1).Copy
    Set GetWb = ActiveWorkbook
    wb.Close False
End Function

Private Function ShowFileDialog() As Variant
    Dim oFD As FileDialog
    Dim x, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Выбрать файлы отчетов" 'заголовок окна диалога
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
        '.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
        .FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
        .InitialFileName = ThisWorkbook.Path & "\" 'назначаем папку отображения и имя файла по умолчанию
        .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
        If oFD.Show = 0 Then Exit Function 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        Dim arr As Variant
        ReDim arr(1 To .SelectedItems.Count)
        For lf = 1 To .SelectedItems.Count
            arr(lf) = .SelectedItems(lf) 'считываем полный путь к файлу
        Next
        ShowFileDialog = arr
    End With
End Function

 
.
Изменено: Евгений Валерьевич - 04.06.2022 15:32:03
 
Евгений Новосельцев, извиняюсь, а как Вы остальные файлы обрабатываете?
Функцией же. Своей или автоматически созданной - неважно.
Но значение для каждого файла будет браться свое.
Без кода обработки всех файлов, непонятно, где Вы ошибаетесь :)
 
.
Изменено: Евгений Валерьевич - 04.06.2022 15:31:44
 
Цитата
Евгений Новосельцев написал:
проблемы с другими файлами из-за названия склада при переименовании столбца
, Вот Вам и подсказка :) Компьютеру нужно объяснить, что откуда и с каким названием брать и что с этим делать :)
Изменено: _Igor_61 - 30.05.2022 17:57:14
 
Евгений Новосельцев, Вы из как обрабатываете в PQ? Скиньте код обработки всех файлов из папки, а не одного.
 
.
Изменено: Евгений Валерьевич - 04.06.2022 15:31:22
 
.
Изменено: Евгений Валерьевич - 04.06.2022 15:31:06
Страницы: 1
Наверх