Скопируйте данные из листа Excel в разные файлы

Question

У меня есть лист Excel, который содержит огромные данные. Данные организованы следующим образом: Набор из 7 столбцов и n строк; как и в таблице, и 1000 таких таблиц помещаются горизонтально с пустой колонкой для разделения. Скриншот ниже ..

...

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

Спасибо,

Answer 1

Тони имеет действительный момент, когда он говорит

Если таблица, начиная с C1 заканчивается на строке 21, делает следующий старт таблицы в C23? Если таблица, начинающаяся с K1, заканчивается в строке 15, начинается ли следующая таблица с K17 или K23?

Так вот код, который будет работать в любом данном условии т.е. устанавливается горизонтально или вертикально.

DATA СНАПШОТ

КОД

'~~> Change this to the relevant Output folder 
Const FilePath As String = "C:\Temp\" 

Dim FileNumb As Long 

Sub Sample() 
    Dim Rng As Range 
    Dim AddrToCopy() As String 
    Dim i As Long 

    On Error GoTo Whoa 

    Application.ScreenUpdating = False 

    Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlTextValues) 

    If Not Rng Is Nothing Then 
     AddrToCopy = Split(Rng.Address, ",") 

     FileNumb = 1 

     For i = LBound(AddrToCopy) To UBound(AddrToCopy) 
      ExportToSheet (AddrToCopy(i)) 
     Next i 
    End If 

    MsgBox "Export Done Successfully" 

LetsContinue: 
    Application.ScreenUpdating = True 
    Exit Sub 
Whoa: 
    MsgBox Err.Description 
    Resume LetsContinue 
End Sub 

Sub ExportToSheet(rngAddr As String) 
    Range(rngAddr).Copy 

    Workbooks.Add 
    ActiveSheet.Paste 

    ActiveWorkbook.SaveAs Filename:= _ 
    FilePath & "Output" & FileNumb & ".csv" _ 
    , FileFormat:=xlCSV, CreateBackup:=False 

    Application.DisplayAlerts = False 
    ActiveWorkbook.Close 
    Application.DisplayAlerts = True 

    FileNumb = FileNumb + 1 
End Sub 

ПРИМЕЧАНИЕ: Приведенный выше код будет работать для клеток только с текстовых значений. Для ячеек с только числовых значений вы должны использовать

Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlNumbers) 

И буквенного значения (как в вашем вопросе выше), используйте этот

Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants) 

HTH

Sid

Answer 2

Пока существует пустой столбец и пустой столбец вокруг любых наборов данных, это будет используйте метод AREAS(), чтобы поместить их в отдельные книги.

Как и в предыдущем примере, он сохраняет CSV, но, конечно же, вы можете сохранить его по своему усмотрению.

Option Explicit 

Sub ExportDataGroups() 
Dim fPATH As String, Grp As Long, DataRNG As Range 

fPATH = "C:\Path\Where\I\Want\My\Files\Saved\" 'remember the final \ 
Application.ScreenUpdating = False 

Set DataRNG = ActiveSheet.UsedRange 

    For Grp = 1 To DataRNG.Areas.Count 
     DataRNG.Areas(Grp).Copy 
     Sheets.Add 
     Range("A1").PasteSpecial 
     ActiveSheet.Move 

     ActiveWorkbook.SaveAs Filename:=fPATH & "-" & Format(Grp, "0000") & ".csv", _ 
      FileFormat:=xlCSV, CreateBackup:=False 
     ActiveWorkbook.Close 
    Next Grp 

MsgBox "A total of " & Grp & " files were created" 
Application.ScreenUpdating = True 

End Sub 

Answer 3

В своем ответе на мой комментарий Вы заявляете: «Имя файла, я никогда не думал об этом Может быть что-нибудь сейчас..» Из горького опыта я могу сказать вам, что иметь дело с тысячами файлов с системными именами - это кошмар. Теперь вам нужно исправить проблему с именем.

Я также нервничаю относительно AddrToCopy = Split(Rng.Address, ",").Rng.Address будет иметь следующий вид: «$ C $ 1: $ I $ 16, $ K $ 1: $ Q $ 16, $ S $ 1: $ Y $ 16, $ C18 $ I $ 33, $ K $ 18: $ Q $ 33, $ S $ 18: $ Y $ 33, ... ". Если вы ищете в Интернете, вы найдете сайты, которые говорят вам, что Rng.Address имеет максимальную длину 253 символа. Я не верю, что это правильно. По моему опыту, Rng.Address усечен в полном субдиапазоне. Мои эксперименты были с Excel 2003, но я обнаружил, что заметил в Интернете, что это ограничение было исправлено в более поздних версиях Excel. Вы много проверяете Rng.Address с вашей версией Excel! Я не знаком с Джерри Бокаером, хотя он предлагает интересное решение. Sid Rout всегда производит отличный код. Если есть проблема, я уверен, что они смогут это исправить.

Однако настоящая цель этого «ответа» состоит в том, чтобы сказать, что я разделил бы эту проблему на три. У этого есть много преимуществ и никаких недостатков, о которых я знаю.

Шаг 1. Создайте новый лист, TableSpec, со следующими столбцами:

A  Worksheet name. (If tables are spread over more than worksheet) 
B  Range. For example: C1:I16, K1:Q16 
C - I Headings from table. For example, AAPL, Open, High, Low, Close, Volume, AdjClose 

Шаг 2. Проверьте рабочий лист TableSpec; например, перечислены ли все таблицы? Подумайте о имени файла и добавьте столбец H, чтобы его содержать. Я прочитал один из ваших комментариев, чтобы вы могли бы «AAPL» в качестве имени файла для первой таблицы, и в этом случае вы могли бы установить H2 в «= C2». Уникален ли «AAPL»? У вас может быть порядковый номер. Есть много вариантов, о которых вы можете думать, прежде чем создавать какие-либо файлы.

Шаг 3. Рабочий лист TableSpec теперь предоставляет всю информацию, необходимую для создания ваших файлов. Вы можете удалить большую часть содержимого и протестировать код создания файла на пару строк.

Надеюсь, вы сможете увидеть преимущества этого ступенчатого подхода, частично, если ваш VBA слаб. Удачи.