Снова здравствуйте! Уже несколько раз за последний год пытался реализовать затею, но всё безрезультатно... Требуется сохранить файл экселя в формат CSV, кодировка - Юникод (UTF-8), разделитель поля - ","(запятая), разделитель текста - " (кавычка). Это описание взял из OpenOffice. Файл нужно всегда сохранять с одним и тем же именем в одном и том же месте (т.е. нужно убрать запрос экселя на замену этого файла). Стандартные варианты сохранения экселя я перебрал, и ни один из них не подходит. Сейчас для сохранения в нужной кодировке пользуюсь OpenOffice. Конечный файл нужен для загрузки на сайт. Если эта тема уже поднималась (я не нашёл) - тыкните пальцем пожалуйста. P.S. Сейчас пишу замученный, так что если описал непонятно - скажите. Я исправлюсь
Снова здравствуйте! Уже несколько раз за последний год пытался реализовать затею, но всё безрезультатно... Требуется сохранить файл экселя в формат CSV, кодировка - Юникод (UTF-8), разделитель поля - ","(запятая), разделитель текста - " (кавычка). Это описание взял из OpenOffice. Файл нужно всегда сохранять с одним и тем же именем в одном и том же месте (т.е. нужно убрать запрос экселя на замену этого файла). Стандартные варианты сохранения экселя я перебрал, и ни один из них не подходит. Сейчас для сохранения в нужной кодировке пользуюсь OpenOffice. Конечный файл нужен для загрузки на сайт. Если эта тема уже поднималась (я не нашёл) - тыкните пальцем пожалуйста. P.S. Сейчас пишу замученный, так что если описал непонятно - скажите. Я исправлюсь emkub
Может быть чуть ближе, но не то... Сейчас голова не соображает толком. НО! заменив Join(b, "-") на Join(b, ",") я получил БОЛЕЕ весомый результат. Теперь разбивка идёт, но каждая запятая считается началом следующей ячейки...
Может быть чуть ближе, но не то... Сейчас голова не соображает толком. НО! заменив Join(b, "-") на Join(b, ",") я получил БОЛЕЕ весомый результат. Теперь разбивка идёт, но каждая запятая считается началом следующей ячейки...emkub
emkub, Excel умеет сохранять файлы в csv-формат только в формате ANSI. Это означает, что если у Вас в тексте есть юникод символы, то они будут заменены на знаки вопроса. В этом случае Excel Вам не поможет и Вам нужно самому писать макрос (или искать в интернете), который будет переводить Excel файл в csv-формат с учетом разделителей строк. Если же у Вас в Excel файле нет символов юникода, то сначала сохраните с помощью Excel в csv-формат (в ANSI-кодировке), а затем уже используйте объект "ADODB.Stream" (этот объект упоминается в сообщении выше) для перекодировки в UTF-8.
emkub, Excel умеет сохранять файлы в csv-формат только в формате ANSI. Это означает, что если у Вас в тексте есть юникод символы, то они будут заменены на знаки вопроса. В этом случае Excel Вам не поможет и Вам нужно самому писать макрос (или искать в интернете), который будет переводить Excel файл в csv-формат с учетом разделителей строк. Если же у Вас в Excel файле нет символов юникода, то сначала сохраните с помощью Excel в csv-формат (в ANSI-кодировке), а затем уже используйте объект "ADODB.Stream" (этот объект упоминается в сообщении выше) для перекодировки в UTF-8.Karataev
For i = 1 To UBound(a) ReDim b(1 To UBound(a, 2)) For j = 1 To UBound(a, 2) 'проходим по элементам строки If Not IsNumeric(a(i, j)) And Not IsDate(a(i, j)) Then 'если не число и не дата то b(j) = """" & a(i, j) & """" 'добавляем кавычи слева и справа Else 'если число или дата b(j) = a(i, j) 'оставляем значение без изменений End If Next c(i) = Join(b, ",") Next
[/vba]
[vba]
Код
For i = 1 To UBound(a) ReDim b(1 To UBound(a, 2)) For j = 1 To UBound(a, 2) 'проходим по элементам строки If Not IsNumeric(a(i, j)) And Not IsDate(a(i, j)) Then 'если не число и не дата то b(j) = """" & a(i, j) & """" 'добавляем кавычи слева и справа Else 'если число или дата b(j) = a(i, j) 'оставляем значение без изменений End If Next c(i) = Join(b, ",") Next
Вот что называется ГЕНИЙ! wild_pig, большое спасибо! Несколько раз прогнал этот макрос - вроде полёт нормальный! Сейчас остался один несущественный вопрос :) В конце такой строки <br><span style="color:#fff9f6;">[showyamap][placemark address="Киев Радунская 42/10 "/][/showyamap]</span> появляется кавычка ("). Ни на что вроде пока не влияет, но любопытно!
Вот что называется ГЕНИЙ! wild_pig, большое спасибо! Несколько раз прогнал этот макрос - вроде полёт нормальный! Сейчас остался один несущественный вопрос :) В конце такой строки <br><span style="color:#fff9f6;">[showyamap][placemark address="Киев Радунская 42/10 "/][/showyamap]</span> появляется кавычка ("). Ни на что вроде пока не влияет, но любопытно!emkub
Намудрил я что-то с кодом, исправил. Одна кавычка не может появиться, они парой добавляются, если в ячейке текст. Текст надо чистить от переносов строк или менять, если они надо, на теги.
Намудрил я что-то с кодом, исправил. Одна кавычка не может появиться, они парой добавляются, если в ячейке текст. Текст надо чистить от переносов строк или менять, если они надо, на теги.wild_pig
Сообщение отредактировал wild_pig - Среда, 13.04.2016, 11:51
Из того, что нашёл: -убрал проверку "если дата" - в таблице есть колонка с датой. После исправления дата появилась. -самая первая ячейка стала отображаться в кавычках.
со своим предыдущим сообщением на счёт одной кавычки буду разбираться дальше....
Из того, что нашёл: -убрал проверку "если дата" - в таблице есть колонка с датой. После исправления дата появилась. -самая первая ячейка стала отображаться в кавычках.
со своим предыдущим сообщением на счёт одной кавычки буду разбираться дальше....emkub
Да это прям наваждение! Если кто может - объясните пожалуйста. Макрос отрабатывает на Ура! Всё, файл сохранён в нужном виде, всё красиво и чётко. НО! При открытии этого файла ОпенОфисом, Первая ячейка отображается в кавычках... Только первая, больше никакие. При открытии Экселем - наоборот: фраза из первой ячейки без кавычек, а все остальные в кавычках (так и должно быть в оригинале). Это портит картину Мира! Если убрать кавычки - тупо пропадает информация из всего первого столбца. Если их оставить - информация сохраняется но не распознаётся как ей положено. Я в растерянности.
Да это прям наваждение! Если кто может - объясните пожалуйста. Макрос отрабатывает на Ура! Всё, файл сохранён в нужном виде, всё красиво и чётко. НО! При открытии этого файла ОпенОфисом, Первая ячейка отображается в кавычках... Только первая, больше никакие. При открытии Экселем - наоборот: фраза из первой ячейки без кавычек, а все остальные в кавычках (так и должно быть в оригинале). Это портит картину Мира! Если убрать кавычки - тупо пропадает информация из всего первого столбца. Если их оставить - информация сохраняется но не распознаётся как ей положено. Я в растерянности.emkub
Сообщение отредактировал emkub - Среда, 13.04.2016, 16:04
Function Writer_ToFile_SkipBOM(FileName As String, Text As String) Const adTypeBinary = 1 Const adTypeText = 2 Const bOverwrite = True Const bAsASCII = False Dim oFS: Set oFS = CreateObject("Scripting.FileSystemObject") Dim oFrom: Set oFrom = CreateObject("ADODB.Stream") Dim sFrom: sFrom = "Windows-1251" Dim oTo: Set oTo = CreateObject("ADODB.Stream") Dim sTo: sTo = "utf-8" Dim sTFSpec: sTFSpec = oFS.GetAbsolutePathName(FileName) If oFS.FileExists(sTFSpec) Then oFS.DeleteFile sTFSpec oFrom.Type = adTypeText oFrom.Charset = sFrom oFrom.Open oTo.Type = adTypeText oTo.Charset = sTo oTo.Open oTo.WriteText Text oTo.Position = 3 Dim BinaryStream As Object Set BinaryStream = CreateObject("ADODB.Stream") BinaryStream.Type = 1 BinaryStream.Mode = 3 BinaryStream.Open oTo.CopyTo BinaryStream oTo.Flush oTo.Close oFrom.Close BinaryStream.SaveToFile sTFSpec, 2 BinaryStream.Close
End Function
[/vba]
Попробуйте записать без бома
[vba]
Код
Function Writer_ToFile_SkipBOM(FileName As String, Text As String) Const adTypeBinary = 1 Const adTypeText = 2 Const bOverwrite = True Const bAsASCII = False Dim oFS: Set oFS = CreateObject("Scripting.FileSystemObject") Dim oFrom: Set oFrom = CreateObject("ADODB.Stream") Dim sFrom: sFrom = "Windows-1251" Dim oTo: Set oTo = CreateObject("ADODB.Stream") Dim sTo: sTo = "utf-8" Dim sTFSpec: sTFSpec = oFS.GetAbsolutePathName(FileName) If oFS.FileExists(sTFSpec) Then oFS.DeleteFile sTFSpec oFrom.Type = adTypeText oFrom.Charset = sFrom oFrom.Open oTo.Type = adTypeText oTo.Charset = sTo oTo.Open oTo.WriteText Text oTo.Position = 3 Dim BinaryStream As Object Set BinaryStream = CreateObject("ADODB.Stream") BinaryStream.Type = 1 BinaryStream.Mode = 3 BinaryStream.Open oTo.CopyTo BinaryStream oTo.Flush oTo.Close oFrom.Close BinaryStream.SaveToFile sTFSpec, 2 BinaryStream.Close
Выход из положения нашёл, но, что называется "через ..опу" - просто добавил первый пустой столбец с пробелом в первой ячейке (А1). Но ведь это не решение.
Выход из положения нашёл, но, что называется "через ..опу" - просто добавил первый пустой столбец с пробелом в первой ячейке (А1). Но ведь это не решение.emkub
Sub uuu() Dim a(), b(), c() Dim i&, j& Dim txt$, sFile$ '--------------------- sFile = "J:\1.csv"
a = ActiveSheet.UsedRange.Value
ReDim c(1 To UBound(a))
For i = 1 To UBound(a) ReDim b(1 To UBound(a, 2)) For j = 1 To UBound(a, 2) b(j) = Chr(34) & a(i, j) & Chr(34) Next c(i) = Join(b, ",") Next
Writer_ToFile_SkipBOM sFile, Join(c, vbCrLf)
Beep MsgBox "А ты боялась" End Sub
Function Writer_ToFile_SkipBOM(FileName As String, Text As String) Const adTypeBinary = 1 Const adTypeText = 2 Const bOverwrite = True Const bAsASCII = False Dim oFS: Set oFS = CreateObject("Scripting.FileSystemObject") Dim oFrom: Set oFrom = CreateObject("ADODB.Stream") Dim sFrom: sFrom = "Windows-1251" Dim oTo: Set oTo = CreateObject("ADODB.Stream") Dim sTo: sTo = "utf-8" Dim sTFSpec: sTFSpec = oFS.GetAbsolutePathName(FileName) If oFS.FileExists(sTFSpec) Then oFS.DeleteFile sTFSpec oFrom.Type = adTypeText oFrom.Charset = sFrom oFrom.Open oTo.Type = adTypeText oTo.Charset = sTo oTo.Open oTo.WriteText Text oTo.Position = 3 Dim BinaryStream As Object Set BinaryStream = CreateObject("ADODB.Stream") BinaryStream.Type = 1 BinaryStream.Mode = 3 BinaryStream.Open oTo.CopyTo BinaryStream oTo.Flush oTo.Close oFrom.Close BinaryStream.SaveToFile sTFSpec, 2 BinaryStream.Close
End Function
[/vba]
вид в йопен офисе
Можно и через правильное место
[vba]
Код
Sub uuu() Dim a(), b(), c() Dim i&, j& Dim txt$, sFile$ '--------------------- sFile = "J:\1.csv"
a = ActiveSheet.UsedRange.Value
ReDim c(1 To UBound(a))
For i = 1 To UBound(a) ReDim b(1 To UBound(a, 2)) For j = 1 To UBound(a, 2) b(j) = Chr(34) & a(i, j) & Chr(34) Next c(i) = Join(b, ",") Next
Writer_ToFile_SkipBOM sFile, Join(c, vbCrLf)
Beep MsgBox "А ты боялась" End Sub
Function Writer_ToFile_SkipBOM(FileName As String, Text As String) Const adTypeBinary = 1 Const adTypeText = 2 Const bOverwrite = True Const bAsASCII = False Dim oFS: Set oFS = CreateObject("Scripting.FileSystemObject") Dim oFrom: Set oFrom = CreateObject("ADODB.Stream") Dim sFrom: sFrom = "Windows-1251" Dim oTo: Set oTo = CreateObject("ADODB.Stream") Dim sTo: sTo = "utf-8" Dim sTFSpec: sTFSpec = oFS.GetAbsolutePathName(FileName) If oFS.FileExists(sTFSpec) Then oFS.DeleteFile sTFSpec oFrom.Type = adTypeText oFrom.Charset = sFrom oFrom.Open oTo.Type = adTypeText oTo.Charset = sTo oTo.Open oTo.WriteText Text oTo.Position = 3 Dim BinaryStream As Object Set BinaryStream = CreateObject("ADODB.Stream") BinaryStream.Type = 1 BinaryStream.Mode = 3 BinaryStream.Open oTo.CopyTo BinaryStream oTo.Flush oTo.Close oFrom.Close BinaryStream.SaveToFile sTFSpec, 2 BinaryStream.Close
Ну что ж, теперь могу отписаться. В целом, последний код Doobera работает. Сохранение правда не такое качественное, как через ОпенОфис. При сохранении макросом, мой загрузчик CSV-файлов спотыкается о встречающуюся в тексте комбинацию кавычка-запятая (",) . Но это уже будет вопрос к форматированию текста.
Так что вопрос можно считать решённым. Всё-таки дело было в злосчастном ВОМе?
wild_pig, Doober, Вам большое спасибо!
Ну что ж, теперь могу отписаться. В целом, последний код Doobera работает. Сохранение правда не такое качественное, как через ОпенОфис. При сохранении макросом, мой загрузчик CSV-файлов спотыкается о встречающуюся в тексте комбинацию кавычка-запятая (",) . Но это уже будет вопрос к форматированию текста.
Так что вопрос можно считать решённым. Всё-таки дело было в злосчастном ВОМе?
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
