Может у кого есть или, что добавить в данный готовый макрос, чтобы сохранять в таком формате CSV?

Question

[iminby]

Имя,"Базовая цена",Категории,Изображения,"Имя атрибута 1","Значение(-я) аттрибута(-ов) 1","Видимость атрибута 1","Глобальный атрибут 1","Имя атрибута 2","Значение(-я) аттрибута(-ов) 2","Видимость атрибута 2","Глобальный атрибут 2","Имя атрибута 3","Значение(-я) аттрибута(-ов) 3","Видимость атрибута 3","Глобальный атрибут 3"

Надо, чтобы текстовые поля где больше одного слова, сохраняло " ".
Есть такой макрос, но он всему задает " ":

Sub SaveAsCSVinQuotes()   
Dim r As Range, c As Range, s As String   
s = Application.GetSaveAsFilename(, "CSV Files (*.csv),*.csv,All Files (*.*),*.*", , "Сохранение в формате CSV в кавычках")   
If s = "False" Then Exit Sub   
Open s For Output As #1   
For Each r In ActiveSheet.UsedRange.Rows   
   s = ""   
   For Each c In r.Cells   
       s = s & ";" & """" & c & """"   
   Next   
   Print #1, Mid$(s, 2)   
Next   
Close #1   
End Sub

Comments

[h8nor]

Готового макроса нет. Решается элементарно.

If c.Value2 Like "* *" Then _
  s = s & ";" & """" & c & """" _
Else s = s & ";" & c

И зачем дублировать вопросы?

[iminby]

Дѣаволъ, Ну там, нарушены были якобы права, можете ваш код приведенный вставить правильно в мой?
Так как я в макросах, без понятия

[h8nor]

Я в правах без понятия. Можете свободно вставлять мой код.

[iminby]

Дѣаволъ, Я имел в виду, там правила задачи вопроса нарушил, так создал повторно.
Можете вставить правильно?Я просто без понятия, как из приведенного мной макроса, вставить ваш кусок, чтобы всё работало

[h8nor]

Зачем вам гвозди, если вы молотка не держали? Попробуйте. Это не сложно.

[iminby]

Дѣаволъ, ну мне нужно таблицу сконвертировать, единожды с нужным макросом, зачем мне знать строение молотка, чтобы им забить гвозди

Answer 1

[h8nor]

У меня возникает чувство, что вы воспользуетесь "единожды с нужным макросом" и забудете нажать кнопку "Отметить решением". А мне потом придётся удалять ответ, чтобы другие не сомневались в его верности.

Sub SaveAsCSVinQuotes()
  Dim r As Range, c As Range, s As String
  '3456789012345678901234567890123456h8nor@ya567890123456789012345678toster56789
  s = Application.GetSaveAsFilename(FileFilter:="CSV файлы (*.csv), *.csv", _
    Title:="Сохранение CSV в кавычках (укажите разделитель в 1 строке SEP=" _
    & Application.International(xlListSeparator) & ")")
  If s = "False" Then Exit Sub
  Open s For Output As #1
  For Each r In ActiveSheet.UsedRange.Rows
    s = ""
    For Each c In r.Cells
      If c.Value2 Like "* *" Then s = s & ";" & """" & c & """" _
      Else s = s & ";" & c
    Next c: Print #1, Mid(s, 2)
  Next r: Close #1
End Sub

И не забудьте экранировать кавычки кавычками, если они будут встречаться в названии колонки.

Comments

[DS28]

забудете нажать кнопку "Отметить решением"

Да, они такие...

[h8nor]

DS28, да, пофиг. Общество потребления само себя сожрёт :)