Добрый день!
Можете ли подсказать, что надо изменить в этом макросе (взят из интернета), чтобы он стал работать на всех листах, а не только на активном? Макрос сохраняет excel в csv.
Я попробовала активизировать каждый лист:
For Each sh In ActiveWorkbook.Worksheets
sh.Activate
но почему-то в результате получается только два итоговых файла, а остальные листы не обрабатывает.
Вот вариант с моими изменениями, который обрабатывает только два листа:
Макрос
Sub ЭкспортПрайсЛистаВФорматеCSV()
On Error Resume Next
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.Activate
' диапазон ячеек с A5 до последней заполненной ячейки в столбце A
' расширенный по горизонтали на 10 столбцов (выгружаются столбцы с A по J)
Dim ra As Range: Set ra = sh.Range(sh.[A5], sh.Range("A" & sh.Rows.Count).End(xlUp)).Resize(, 10)
' формируем текстовую строку, содержащую текст диапазона в формате CSV
CSVtext$ = Range2CSV(ra, ";") ' можно указать другой разделитель столбцов
' создаём в папке с файлом XLS подпапку для CSV-прайсов (если такой папки ещё нет)
CSVfolder$ = ThisWorkbook.Path & "\CSV prices\": MkDir CSVfolder$
' формируем имя создаваемого файла CSV (c указанием текущей даты)
CSVfilename$ = Format(Now, "YYYY MM DD HH-NN-SS") & ".csv"
' сохраняем текстовую CSV-строку CSVtext$ в файл с именем CSVfilename$
SaveTXTfile CSVfolder$ & CSVfilename$, CSVtext$
Next sh
End Sub
Function Range2CSV(ByRef ra As Range, Optional ByVal ColumnsSeparator$ = ";", _
Optional ByVal RowsSeparator$ = vbNewLine) As String
If ra.Cells.Count = 1 Then Range2CSV = ra.Value & RowsSeparator$: Exit Function
If ra.Areas.Count > 1 Then
Dim ar As Range
For Each ar In ra.Areas
Range2CSV = Range2CSV & Range2CSV(ar, ColumnsSeparator$, RowsSeparator$)
Next ar
Exit Function
End If
arr = ra.Value
' иначе конкатенация длинных текстовых строк притормаживает макрос
chr34$ = Chr(34): buffer$ = "": buffer2$ = "": Const BufferLen& = 15000
For i = LBound(arr, 1) To UBound(arr, 1)
txt = "": For j = LBound(arr, 2) To UBound(arr, 2)
txt = txt & ColumnsSeparator$ & chr34$ & Replace(arr(i, j), chr34$, "'") & chr34$
Next j
buffer$ = buffer$ & Mid(txt, Len(ColumnsSeparator$) + 1) & RowsSeparator$
' для многократного увеличения производительности при больших диапазонах данных
If Len(buffer$) > BufferLen& Then
buffer2$ = buffer2$ & buffer$: buffer$ = ""
If Len(buffer2$) > BufferLen& * 40 Then _
Range2CSV = Range2CSV & buffer2$: buffer2$ = "" ': DoEvents
End If
Next i
Range2CSV = Range2CSV & buffer2$ & buffer$
End Function
Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean
On Error Resume Next: Err.Clear
Set fso = CreateObject("scripting.filesystemobject")
Set ts = fso.CreateTextFile(filename, True)
ts.Write txt: ts.Close
SaveTXTfile = Err = 0
Set ts = Nothing: Set fso = Nothing
End Function
На листе, в какой-либо ячейке может быть текст с точкой запятой?
Если может, то способ, который вы нашли в интернете, вам не подходит. В этом случае вам надо использовать другой способ - создание csv-файла с помощью экселя.
Нет, точки с запятой нигде нет. Только если случайная опечатка где-то вдруг возникнет.
При использовании макросов, не обязательно переходить на лист, с которым надо работать. То есть этот код не всегда нужно использовать:
sh.Activate
То есть в вашем случае достаточно так:
Код
Sub ЭкспортПрайсЛистаВФорматеCSV()
Dim sh As Worksheet
On Error Resume Next
For Each sh In ActiveWorkbook.Worksheets
' диапазон ячеек с A5 до последней заполненной ячейки в столбце A
' расширенный по горизонтали на 10 столбцов (выгружаются столбцы с A по J)
Dim ra As Range: Set ra = sh.Range(sh.[A5], sh.Range("A" & sh.Rows.Count).End(xlUp)).Resize(, 10)
' формируем текстовую строку, содержащую текст диапазона в формате CSV
CSVtext$ = Range2CSV(ra, ";") ' можно указать другой разделитель столбцов
' создаём в папке с файлом XLS подпапку для CSV-прайсов (если такой папки ещё нет)
CSVfolder$ = ThisWorkbook.Path & "\CSV prices\": MkDir CSVfolder$
' формируем имя создаваемого файла CSV (c указанием текущей даты)
CSVfilename$ = Format(Now, "YYYY MM DD HH-NN-SS") & ".csv"
' сохраняем текстовую CSV-строку CSVtext$ в файл с именем CSVfilename$
SaveTXTfile CSVfolder$ & CSVfilename$, CSVtext$
Next sh
End Sub
Этот код делает следующее:
Set ra = sh.Range(sh.[A5], sh.Range("A" & sh.Rows.Count).End(xlUp)).Resize(, 10)
Предполагается, что данные начинаются с ячейки A5. У вас данные начинаются с ячейки A5?
Затем макрос ищет в столбце A последнюю строку с данными. При использовании "End", на листе не должно быть скрытых строк, т.к. команда "End" не ищет в скрытых строках.
sh.Range("A" & sh.Rows.Count).End(xlUp))
Затем макрос расширяет диапазон до десятого столбца:
Resize(, 10)
После чего макрос работает с диапазоном:
A5:J_последняя строка в столбце A.
У вас такие же диапазоны? Макрос вы взяли в интернете, макрос специально для вашего файла не делали.
Да, я поняла, когда смотрела макрос, что можно менять при желании ячейку-начало и количество столбцов.
Но поскольку у меня сводные, то как раз подошло, начиная с А5 и до конца столбца. Правда появляются в конце слова "Общий итог", ненужные, но мне это некритично.
И количество столбцов я пока не меняла, т.к. еще не знаю точно, сколько их надо будет. Вероятно около 7.
Про скрытые строки не знала. У меня их здесь нет, но буду знать.
Запустите этот макрос. После работы макроса отобразите окно View - Immediate Window.
Подсчитайте, сколько фрагментов эксель-листа в окне "Immediate Window" и посмотрите адреса фрагментов эксель-листа в окне "Immediate Window". Затем посмотрите свои листы и сравните. Всё ли нормально?
Код
Sub ЭкспортПрайсЛистаВФорматеCSV()
Dim sh As Worksheet
On Error Resume Next
For Each sh In ActiveWorkbook.Worksheets
' диапазон ячеек с A5 до последней заполненной ячейки в столбце A
' расширенный по горизонтали на 10 столбцов (выгружаются столбцы с A по J)
Dim ra As Range: Set ra = sh.Range(sh.[A5], sh.Range("A" & sh.Rows.Count).End(xlUp)).Resize(, 10)
Debug.Print ra.Address
' формируем текстовую строку, содержащую текст диапазона в формате CSV
CSVtext$ = Range2CSV(ra, ";") ' можно указать другой разделитель столбцов
' создаём в папке с файлом XLS подпапку для CSV-прайсов (если такой папки ещё нет)
CSVfolder$ = ThisWorkbook.Path & "\CSV prices\": MkDir CSVfolder$
' формируем имя создаваемого файла CSV (c указанием текущей даты)
CSVfilename$ = Format(Now, "YYYY MM DD HH-NN-SS") & ".csv"
' сохраняем текстовую CSV-строку CSVtext$ в файл с именем CSVfilename$
SaveTXTfile CSVfolder$ & CSVfilename$, CSVtext$
Next sh
End Sub
С фрагментами все в порядке.
Сюда подставьте имя листа, из которого извлекаются данные (вы это хотели сделать):
' формируем имя создаваемого файла CSV (c указанием текущей даты)
CSVfilename$ = Format(Now, "YYYY MM DD HH-NN-SS") & ".csv"
У вас указано время, какие-то листы возможно моментально обрабатываются (в течение секунды) и у них совпадает время.
CSVfilename$ = ActiveSheet.name & ".csv"
Так?
ActiveSheet - это лист, который отображается на мониторе.
В вашем случае вы перемещаетесь по листам таким способом:
For Each sh In ActiveWorkbook.Worksheets
Значит вам надо использовать переменную "sh". Переменная "sh" - это и есть лист. Печатаете в коде "sh" ставите точку и выбираете нужный член.
Сюда подставьте имя листа, из которого извлекаются данные (вы это хотели сделать):
' формируем имя создаваемого файла CSV (c указанием текущей даты)
CSVfilename$ = Format(Now, "YYYY MM DD HH-NN-SS") & ".csv"
У вас указано время и какие-то листы возможно моментально обрабатываются (несколько листов обрабатывается в течение одной секунды) и у них совпадает время.
Сделала:
CSVfilename$ = sh.name & ".csv"
Работает! Все листы обработаны, и файлы называются как листы.
Спасибо!