0 Пользователей и 1 Гость просматривают эту тему.
  • 3 Ответов
  • 14545 Просмотров
*

zikkuratvk

  • Глобальный модератор
  • 4818
  • 344 / 2
  • Обслуживаем проекты - дорого.
Потребовалось мне тут обновить цены для большого количества товаров в виртуе... Экспортнул цены... Отредактировал на n%. И думаю, блин ведь эксель не умеет работать нормально с разделителями. Ладно если а разделителями он еще как то умеет работать то вот с ограничителями ни в коем разе... И вот задуман был небольшой макрос, который я думаю поможет многим людям которые оказались в схожей ситуации.

Как учить устанавливать макросы не буду, надо будет разберетесь )) а так работает отлично на 2007 Excel.

Код
Sub csvDelim()
' Для создания csv-файла заданного формата
' Макрос добавлен 2011-02-08
' Создает csv-файл из эксельного.
' Просит указать диапазон заголовков. Необходимо указывать именно заголовки!
' Определяет диапазон строк по первому столбцу
' Спрашивает маску файла
' Можно задать разделитель и ограничитель полей
Dim i As Long, j As Long
Dim PathForFile As String
Dim NameForSave As String
Dim tempstr As String
Dim Rn As Range
Dim Delim1 As String
Dim Delim2 As String
Dim Val
On Error Resume Next
PathForFile = "C:\Готово\"
MsgBox "На вашем локальном диске будет создана папка ""Готово""", vbOKOnly, "Создание папки"
MkDir PathForFile
If Err.Number <> 75 And Err.Number <> 0 Then GoTo Ext
Err.Clear
On Error GoTo Ext
NameForSave = InputBox("Введите маску файла", "Ввод", ActiveWorkbook.Name)
Delim1 = CStr(InputBox("Введите разделитель полей", "Ввод", ";"))
Delim2 = CStr(InputBox("Введите ограничитель полей", "Ввод", """"))
Randomize
NameForSave = NameForSave & "_" & CStr(Date)
Set Rn = Application.InputBox("Выделите, пожалуйста, все ЗАГОЛОВКИ нужных столбцов.", , , , , , , 8)
i = 1
While Len(Rn.Cells(1).Offset(i).Value) > 0
    i = i + 1
Wend
If i = 1 Then Exit Sub
Val = Rn.Offset(1).Resize(i).Value
On Error Resume Next
Kill PathForFile & "\" & NameForSave & ".csv"
Err.Clear
On Error GoTo Ext
Open PathForFile & "\" & NameForSave & ".csv" For Output As #1
For i = 1 To UBound(Val, 1) - 1
    tempstr = Delim2 & CStr(Val(i, 1)) & Delim2
    For j = 2 To UBound(Val, 2)
        tempstr = tempstr & Delim1 & Delim2 & CStr(Val(i, j)) & Delim2
    Next j
    Print #1, tempstr
Next i
Close #1
Exit Sub
Ext:
MsgBox "Извините, ошибка!" & Err.Number & " " & Err.Description, vbOKOnly, "Упс!"
End Sub

Спасибо сестренке которая гуру офиса, экселя и просто баз данных - ведь благодаря ей родился этот макрос :) я бы нашел более тривиальный способ экспорта :-)
Хочется уникальное расширение? ===>>>> JoomLine - Разрабатываем расширения под заказ.
Использую хостинг TimeWeb и Reg
*

iskirikov

  • Новичок
  • 3
  • 0 / 0
Re: Правильный экспорт из Excel в CSV
« Ответ #1 : 27.11.2013, 10:22:11 »
zikkuratvk , Спасибо Огромнейшее! как раз то что я искал!!
Не видел ни одного примера макроса, где ограничитель полей "" можно было бы указать вручную! Круто! :-)

Вот только мне надо, чтобы значения были по умолчанию (без выбора)
Разделитель ";" Ограничитель (пусто - без "") Заголовок $A1$:$Q1$

 а папка создавалась в той же  директории, что и файл с которого экспортируются данные

Подскажите, пожалуйста, что нужно исправить в коде, я с VBA недавно стал знакомиться, поэтому для меня это пока еще темный лес :-(
Еще раз Спасибо!
*

iskirikov

  • Новичок
  • 3
  • 0 / 0
Re: Правильный экспорт из Excel в CSV
« Ответ #2 : 27.11.2013, 11:07:24 »
Как сделать  значения  по умолчанию разобрался методом тыка)))
Delim1 = CStr(";")
Delim2 = CStr("")
Randomize
NameForSave = NameForSave & "_" & CStr(Date)
Set Rn = Range("A1:Q1")


А Вопрос по поводу того чтобы Папка создавалась в той же  директории, что и файл с которого экспортируются данные Актуальный
*

iskirikov

  • Новичок
  • 3
  • 0 / 0
Re: Правильный экспорт из Excel в CSV
« Ответ #3 : 27.11.2013, 11:37:59 »
Нашел Решение))))  ^-^

Sub csvDelim()
' Для создания csv-файла заданного формата
' Макрос добавлен 2011-02-08
' Создает csv-файл из эксельного.
' Просит указать диапазон заголовков. Необходимо указывать именно заголовки!
' Определяет диапазон строк по первому столбцу
' Спрашивает маску файла
' Можно задать разделитель и ограничитель полей
Dim i As Long, j As Long
Dim PathForFile As String
Dim NameForSave As String
Dim tempstr As String
Dim Rn As Range
Dim Delim1 As String
Dim Delim2 As String
Dim Val
On Error Resume Next
PathForFile$ = ThisWorkbook.Path & "\Готово\": MkDir PathForFile$
MsgBox "На вашем локальном диске будет создана папка ""Готово""", vbOKOnly, "Создание папки"

If Err.Number <> 75 And Err.Number <> 0 Then GoTo Ext
Err.Clear
On Error GoTo Ext
NameForSave = InputBox("Введите маску имени файла", "Ввод", ActiveWorkbook.Name)
Delim1 = CStr(";")
Delim2 = CStr("")
Randomize
NameForSave = NameForSave & "_" & CStr(Date)
Set Rn = Range("A1:Q1")
i = 1
While Len(Rn.Cells(1).Offset(i).Value) > 0
    i = i + 1
Wend
If i = 1 Then Exit Sub
Val = Rn.Offset(1).Resize(i).Value
On Error Resume Next
Kill PathForFile$ & "\" & NameForSave & ".csv"
Err.Clear
On Error GoTo Ext
Open PathForFile$ & "\" & NameForSave & ".csv" For Output As #1
For i = 1 To UBound(Val, 1) - 1
    tempstr = Delim2 & CStr(Val(i, 1)) & Delim2
    For j = 2 To UBound(Val, 2)
        tempstr = tempstr & Delim1 & Delim2 & CStr(Val(i, j)) & Delim2
    Next j
    Print #1, tempstr
Next i
Close #1
Exit Sub
Ext:
MsgBox "Извините, ошибка!" & Err.Number & " " & Err.Description, vbOKOnly, "Упс!"
End Sub


Ограмедное спасибо за супермакрос )))) *DRINK*
Чтобы оставить сообщение,
Вам необходимо Войти или Зарегистрироваться
 

Экспорт в соцсети

Автор BAHbKA

Ответов: 3
Просмотров: 2421
Последний ответ 26.07.2015, 16:35:54
от Senturov
CSVI импорт экспорт

Автор Vasja555

Ответов: 0
Просмотров: 2367
Последний ответ 05.02.2015, 15:40:45
от Vasja555
Экспорт товаров с помощью CSVI

Автор Катрин

Ответов: 4
Просмотров: 1888
Последний ответ 22.04.2014, 10:06:25
от Vladmr163
Экспорт картинки товара и краткого описания в фотоальбомы в группе ВКонтакте

Автор mostachev

Ответов: 1
Просмотров: 3006
Последний ответ 25.03.2014, 02:07:22
от Dutch
экспорт csv из 1с 7.7

Автор sega

Ответов: 4
Просмотров: 6837
Последний ответ 28.02.2014, 22:08:21
от C@H