Доброе утро уважаемые форумчане!
Собрал макрос, который текст в столбце сохраняет в кодировке unicode.
По столбцу А работает все прекрасно! А по столбцу C сохраняет только 4 ячейки.
Причем если добавляю множество строк в столбец А (больше чем строк в столбце C), то сохранение столбца идет отлично!
Файлы сохраняется в папку C:\БЕГУШКИ ПАВЛОДАР файлы называются:
ПАВЛОДАРМУЗ
ПАВЛОДАРНТВ
ПАВЛОДАРПКВС
ПАВЛОДАРРЕН
ПАВЛОДАРРТР
ПАВЛОДАРСТС
ПАВЛОДАРТНТ
Может у меня такая проблема, что переменные для разных столбцов одни и те же, только меняется номер столбца...
Листинг кода:
Этот код работает отлично, если бы он был применим к столбцу A и код вида:
Но если 1 заменить на 3 (столбец С), то сохраняет всего 4 строки. После написания этого текста, сохраняет уже только 2 строки 
Как решить проблему, пока не понимаю.
Файл примера прилагаю вложением.
Собрал макрос, который текст в столбце сохраняет в кодировке unicode.
По столбцу А работает все прекрасно! А по столбцу C сохраняет только 4 ячейки.
Причем если добавляю множество строк в столбец А (больше чем строк в столбце C), то сохранение столбца идет отлично!
Файлы сохраняется в папку C:\БЕГУШКИ ПАВЛОДАР файлы называются:
ПАВЛОДАРМУЗ
ПАВЛОДАРНТВ
ПАВЛОДАРПКВС
ПАВЛОДАРРЕН
ПАВЛОДАРРТР
ПАВЛОДАРСТС
ПАВЛОДАРТНТ
Может у меня такая проблема, что переменные для разных столбцов одни и те же, только меняется номер столбца...
Листинг кода:
| Код |
|---|
Sub СохранениеСТС()
Sheets("Павлодар".Select
If IsEmpty(Range("C1") = True Then
MsgBox "Первая строка пустая."
Else
End If
If IsEmpty(Range("C2") = True Then
MsgBox "Вторая строка пустая."
Else
Dim x As Long, lr&, strArray
Dim strWholeFile As String
lr = Cells(1, 1).End(xlDown).Row 'последняя строка
ReDim strArray(1 To lr)
For x = 1 To lr - 1
strWholeFile = strWholeFile & Cells(x, 3).Value & vbCrLf
Next
strWholeFile = strWholeFile & Cells(x, 3).Value ' special case w/o vbCrlf
Dim ADOStream
Set ADOStream = CreateObject("ADODB.Stream"
With ADOStream
.Open
.Position = 0
.Charset = "unicode"
.WriteText strWholeFile
.SaveToFile "C:\БЕГУШКИ ПАВЛОДАР\ПАВЛОДАРСТС.txt", 2 ' overwrite if exists
.Close
End With
End If
End Sub |
| Код |
|---|
strWholeFile = strWholeFile & Cells(x, 1).Value & vbCrLf Next strWholeFile = strWholeFile & Cells(x, 1).Value ' special case w/o vbCrlf |
Как решить проблему, пока не понимаю.
Файл примера прилагаю вложением.
Изменено: - 23.04.2015 07:51:58
