Добрый день.
Подскажите пожалуйста с созданием макроса.
Параметры:
Есть сводная таблица:
Конечная цель.
Необходимо чтобы при выделении ячейки и выполнении макроса, происходила выгрузка в формате .txt в место где хранится excel файл.
Как видно запись не одна и есть одно важное условие. При выгрузке, файл должен называться как дата слева от номеров.
Т.е. в идеальном варианте в исходя из таблицы выше, в месте где лежит файл excel, должно появиться 4 файла .txt. с названиями дат, а внутри этих файлов должны быть номера относящиеся к этим датам.
Порывшись на форуме нашел вот такой макрос, но тут проблема в названии и при выделении и выполнении макроса, старый перезаписывается.
Помогите доработать пожалуйста.
Подскажите пожалуйста с созданием макроса.
Параметры:
Есть сводная таблица:
| 11.07.2014 | 5136 |
| 7260 | |
| 17.07.2014 | 5229 |
| 9280 | |
| 24.07.2014 | 5158 |
| 6960 | |
| 25.07.2014 | 6860 |
Необходимо чтобы при выделении ячейки и выполнении макроса, происходила выгрузка в формате .txt в место где хранится excel файл.
Как видно запись не одна и есть одно важное условие. При выгрузке, файл должен называться как дата слева от номеров.
Т.е. в идеальном варианте в исходя из таблицы выше, в месте где лежит файл excel, должно появиться 4 файла .txt. с названиями дат, а внутри этих файлов должны быть номера относящиеся к этим датам.
Порывшись на форуме нашел вот такой макрос, но тут проблема в названии и при выделении и выполнении макроса, старый перезаписывается.
Помогите доработать пожалуйста.
| Код |
|---|
Sub ExportRange() Dim Filename As String Dim NumRows As Long, NumCols As Integer Dim r As Long, c As Integer Dim Data Dim ExpRng As Range Set ExpRng = Selection NumCols = ExpRng.Columns.Count NumRows = ExpRng.Rows.Count Filename = ThisWorkbook.Path & "\textfile.txt" Open Filename For Output As #1 For r = 1 To NumRows For c = 1 To NumCols Data = ExpRng.Cells(r, c).Value If IsNumeric(Data) Then Data = Val(Data) If IsEmpty(ExpRng.Cells(r, c)) Then Data = "" If c <> NumCols Then Write #1, Data; Else Write #1, Data End If Next c Next r Close #1 End Sub |
Изменено: - 02.04.2015 14:51:36
