Скопируйте несмежные ячейки данных в одну рабочую книгу

Question

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

Так что этот код скопирует указанные данные измножество других книг Excel в форме xlsx в основную книгу Excel, а до этого она будет сканировать папку, содержащую все различные файлы данных и основной файл (все файлы, которые должны быть перенесены сюда в виде таблицы), например, Test3. xlsx, Test4.xlsx, Test.xlxs и Main.xlsm в папке ScanFiles. поэтому каждый раз, когда в папку попадают новые файлы, она автоматически обновляет основную рабочую книгу, открывая рабочие книги данных, затем копирует необходимые данные и вставляет их в основную рабочую книгу после нажатия кнопки.

Sub ScanFiles()
Dim myFile As String, path As String
Dim erow As Long, col As Long

path = "c:\Scanfiles\"
myFile = Dir(path & "*.xlsx")

Application.ScreenUpdating = False

Do While myFile <> ""
Workbooks.Open (path & myFile)
Windows(myFile).Activate

Set copyrange = Sheets("sheet1").Range("A18,B18,C18,D18,A19,B19,C19,D19")

Windows("master-wbk.xlsm").Activate

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

col = 1
For Each cel In copyrange
cel.Copy

Cells(erow, col).PasteSpecial xlPasteValues

col = col + 1

Next

Windows(myFile).Close savechanges:=False
myFile = Dir()
Loop
Range("A:E").EntireColumn.AutoFit

Application.ScreenUpdating = True

End Sub

Цели:1-й: тип файла orignal находится в «file», а не в xlsx, поэтому надейтесь найти способ автоматически открыть файл в формате xlsx перед началом копирования данных. 2-й: требует 3 типа указанных данных, например, имя, фамилия (оба они находятся в фиксированной позиции всегда в A18 до D18 и A19 до D19, 3-й - для поиска даты, однако дата почти всегда находится в разных позициях в данныхлист, так что я надеюсь добавить часть к коду, который заставляет его искать что-то вроде «закончено 20190808», оно всегда будет начинаться с конца, но всегда будет в строках различий или даже столбцах. Мне также нужно расположить данные в соответствии сдата от самой новой (сверху) до самой старой (снизу) и указывайте месяц даты словами, а не числами, например, июнь. Глубоко цените любую форму помощи, но, если возможно, небольшая часть кода, которая может быть добавлена ​​в мою кодировку, сделает еенамного проще, потому что мне поручено сделать это в очень ограниченное количество времени Спасибо !!!

Answer 1

Вот некоторый код, который делает вещи, похожие на то, что вы описываете. Анимированный .gif показывает, что он работает, шагая по коду. Сначала отображаются 2 файла данных (.xlsx), чтобы вы имели представление об их содержании. Каждый из них находится в той же папке, что и основная рабочая книга, и содержит данные в столбце А. Затем, по мере выполнения кода, каждый файл открывается, его данные обрабатываются (строка 3 удаляется) и переносятся в соседние столбцы основной рабочей книги. Код не ограничивается файлами .xlsx и будет работать с текстовыми файлами, если определено ext.

Надеемся, когда вы поймете, как это работает, вы можете изменить его, чтобы применить к своемуcase.

Option Explicit
Sub CombineFiles()
Dim theDir As String, numFiles As Integer
Dim sh As Worksheet, wk As Workbook, newSheet As Worksheet
Dim newColumn As Range, r As Range, s As String
Const ext = ".xlsx"
    Err.Clear
    theDir = ThisWorkbook.Path
    Set newSheet = ThisWorkbook.Sheets.Add
    newSheet.Name = "Combined"
    Set newColumn = newSheet.Range("A1")
    'Loop through all files in directory
    s = Dir(theDir & "\*" & ext)
    While s <> ""
        numFiles = numFiles + 1
        On Error Resume Next
        Set wk = Workbooks.Open(theDir & "\" & s)
        Set sh = ActiveSheet
        sh.Rows(3).Delete Shift:=xlUp
        Set r = Range("A1")
        Range(r, r.End(xlDown)).Copy
        newSheet.Activate
        newColumn.Offset(0, numFiles) = wk.Name
        newColumn.Offset(1, numFiles).Select
        newSheet.Paste
        Application.DisplayAlerts = False
        wk.Close False
        Application.DisplayAlerts = True
        s = Dir()
    Wend
    MsgBox (numFiles & " files were processed.")
End Sub

Для копирования / вставки изображений см. примеры на this или this стр. Чтобы найти последнюю ячейку, содержащую данные в столбце, см. this page;обратите внимание, что в одном примере используется команда .find. В более общем плане, чтобы узнать, как использовать .find в vba, используйте средство записи макросов, а затем настройте полученный код.