Копировать данные из листа Excel в разные файлы - PullRequest
Новая
       54

Копировать данные из листа Excel в разные файлы

4 голосов
/ 21 марта 2012

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

enter image description here ...

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

Спасибо

Ответы [ 3 ]

6 голосов
/ 21 марта 2012

Тони имеет правильную точку, когда говорит

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

Итак, вот код, который будет работать в любых условиях, т. Е. Данные заданы горизонтально или вертикально.

SNAPSHOT ДАННЫХ

enter image description here

CODE 

'~~> 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)

НТН

Sid

2 голосов
/ 22 марта 2012

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

Я также нервничаю по поводу 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!Я не знаком с Джерри Бокером, хотя он предлагает интересное решение.Сид Роут всегда производит отличный код.Если есть проблема, я уверен, что они смогут ее исправить.

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

Шаг 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.Удачи.

2 голосов
/ 22 марта 2012

Если вокруг каких-либо наборов данных есть пустая строка и пустой столбец, метод 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
...