Всем доброго времени суток! Помогите пожалуйста написать макрос. Есть таблица с данными разного типа (числа, буквы). Нужен макрос, который проверял бы на соответствие нужные ячейки и при положительной проверке добавлял данные в создаваемый txt файл. Многие примеры перелопатил но отредактировать до нужного результата пока не удается. Даже элементарный экспорт из одной ячейки в txt не знаю как написать, и найти не получается. Все, что нашел, это:
[vba]
Код
Sub ExportAsText() Open "C:\primer.txt" For Output As #1 Print #1, Join(Application.Transpose([c7:d7].Value), vbLf) Close #1 End Sub
[/vba]
Но почему то не работает... В прикрепленных файлах примеры того, что есть и должно быть. Надеюсь на отзывчивость и адекватность.
Всем доброго времени суток! Помогите пожалуйста написать макрос. Есть таблица с данными разного типа (числа, буквы). Нужен макрос, который проверял бы на соответствие нужные ячейки и при положительной проверке добавлял данные в создаваемый txt файл. Многие примеры перелопатил но отредактировать до нужного результата пока не удается. Даже элементарный экспорт из одной ячейки в txt не знаю как написать, и найти не получается. Все, что нашел, это:
[vba]
Код
Sub ExportAsText() Open "C:\primer.txt" For Output As #1 Print #1, Join(Application.Transpose([c7:d7].Value), vbLf) Close #1 End Sub
[/vba]
Но почему то не работает... В прикрепленных файлах примеры того, что есть и должно быть. Надеюсь на отзывчивость и адекватность.Noober89
не уверен в своей адекватности , но давно использую для сохранения в тхт такую ЮДФку: [vba]
Код
Function txt_write_from_ARR(m As Variant, Optional filename$) Dim i#, ii#, s$, n& m = m n = FreeFile() On Error GoTo er If filename = "" Then filename = ActiveWorkbook.Path & "\file.csv" Open filename For Output As #n For i = 1 To UBound(m) s = m(i, 1) For ii = 2 To UBound(m, 2) s = s & vbTab & m(i, ii) Next Print #n, s If i Mod 10000 = 0 Then DoEvents Application.StatusBar = Format(i / UBound(m), "0%") & ". " & i & " из " & UBound(m) End If Next Close #1 Application.StatusBar = False txt_write_from_ARR = True Exit Function er: txt_write_from_ARR = False End Function
не уверен в своей адекватности , но давно использую для сохранения в тхт такую ЮДФку: [vba]
Код
Function txt_write_from_ARR(m As Variant, Optional filename$) Dim i#, ii#, s$, n& m = m n = FreeFile() On Error GoTo er If filename = "" Then filename = ActiveWorkbook.Path & "\file.csv" Open filename For Output As #n For i = 1 To UBound(m) s = m(i, 1) For ii = 2 To UBound(m, 2) s = s & vbTab & m(i, ii) Next Print #n, s If i Mod 10000 = 0 Then DoEvents Application.StatusBar = Format(i / UBound(m), "0%") & ". " & i & " из " & UBound(m) End If Next Close #1 Application.StatusBar = False txt_write_from_ARR = True Exit Function er: txt_write_from_ARR = False End Function
не уверен в своей адекватности , но давно использую для сохранения в тхт такую ЮДФку:
Очень интересно! А у Вас исправно функционирует предоставленный Вами код? У меня при запуске ошибок не возникает, но файл остается так же пустым, как и раньше. Видимо что-то делаю не так...
не уверен в своей адекватности , но давно использую для сохранения в тхт такую ЮДФку:
Очень интересно! А у Вас исправно функционирует предоставленный Вами код? У меня при запуске ошибок не возникает, но файл остается так же пустым, как и раньше. Видимо что-то делаю не так...Noober89
Вы из моего файла запускали? А перед нажатием на кнопку какие ячейки выделили?
Да, из вложенного файла. Разные диапазоны выделял (например B6:D6), и по одной ячейке тоже. Возможно я запутал с этим примерным кодом, что в описании. Вообще нужно, чтобы макрос проходил по определенным ячейкам и проверял на соответствие, после чего исходя из проверки формировал файл в формате txt с содержанием, что во вложении. Допустим на каждую "АБВГ" приходится 3 "бвг" и 9 строк "ежз". Это неизменно. Этих АБВГ может быть несколько, и соответственно прямопропорционально увеличится количество остальных "бвг" и "ежз" строк. ДЕЖЗ тут лишнее. Ох, такое страшное и запутанное описание, что боюсь тут мало кто разберется )))
Вы из моего файла запускали? А перед нажатием на кнопку какие ячейки выделили?
Да, из вложенного файла. Разные диапазоны выделял (например B6:D6), и по одной ячейке тоже. Возможно я запутал с этим примерным кодом, что в описании. Вообще нужно, чтобы макрос проходил по определенным ячейкам и проверял на соответствие, после чего исходя из проверки формировал файл в формате txt с содержанием, что во вложении. Допустим на каждую "АБВГ" приходится 3 "бвг" и 9 строк "ежз". Это неизменно. Этих АБВГ может быть несколько, и соответственно прямопропорционально увеличится количество остальных "бвг" и "ежз" строк. ДЕЖЗ тут лишнее. Ох, такое страшное и запутанное описание, что боюсь тут мало кто разберется )))Noober89
Спасибо большое! Вроде немного разобрался. Теперь все работает, но там какая-то своя система. А можно ли подредактировать код таким образом, чтобы макрос автоматически, без выделения вручную, формировал результат?
Спасибо большое! Вроде немного разобрался. Теперь все работает, но там какая-то своя система. А можно ли подредактировать код таким образом, чтобы макрос автоматически, без выделения вручную, формировал результат?Noober89
это у меня пользовательская функция - как хотите так и передавайте. в нее данные. Можно управляющим макросом, можно в листе формулу написать - см. пример - в зеленой ячейке формула, и макрос отдельно для сохранения данных до последней строки и столбца. [vba]
Код
Sub ExportAsText() With ActiveSheet LastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row LastColumn = .Range("A2").SpecialCells(xlCellTypeLastCell).Column MsgBox txt_write_from_ARR(.Range(.Cells(2, 1), .Cells(LastRow, LastColumn)), "C:\primer.txt") & vbCr & LastRow & " x " & LastColumn End With End Sub Function txt_write_from_ARR(m As Variant, Optional filename$) Dim i#, ii#, s$, n& m = m n = FreeFile() On Error GoTo er If filename = "" Then filename = ActiveWorkbook.Path & "\file.csv" 'Open filename For Append As #n'If append_to_last_row Then Open filename For Output As #n For i = 1 To UBound(m) s = m(i, 1) For ii = 2 To UBound(m, 2) s = s & vbTab & m(i, ii) Next Print #n, s If i Mod 10000 = 0 Then DoEvents Application.StatusBar = Format(i / UBound(m), "0%") & ". " & i & " èç " & UBound(m) End If Next Close #1 Application.StatusBar = False txt_write_from_ARR = True Exit Function er: txt_write_from_ARR = False End Function
[/vba]
это у меня пользовательская функция - как хотите так и передавайте. в нее данные. Можно управляющим макросом, можно в листе формулу написать - см. пример - в зеленой ячейке формула, и макрос отдельно для сохранения данных до последней строки и столбца. [vba]
Код
Sub ExportAsText() With ActiveSheet LastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row LastColumn = .Range("A2").SpecialCells(xlCellTypeLastCell).Column MsgBox txt_write_from_ARR(.Range(.Cells(2, 1), .Cells(LastRow, LastColumn)), "C:\primer.txt") & vbCr & LastRow & " x " & LastColumn End With End Sub Function txt_write_from_ARR(m As Variant, Optional filename$) Dim i#, ii#, s$, n& m = m n = FreeFile() On Error GoTo er If filename = "" Then filename = ActiveWorkbook.Path & "\file.csv" 'Open filename For Append As #n'If append_to_last_row Then Open filename For Output As #n For i = 1 To UBound(m) s = m(i, 1) For ii = 2 To UBound(m, 2) s = s & vbTab & m(i, ii) Next Print #n, s If i Mod 10000 = 0 Then DoEvents Application.StatusBar = Format(i / UBound(m), "0%") & ". " & i & " èç " & UBound(m) End If Next Close #1 Application.StatusBar = False txt_write_from_ARR = True Exit Function er: txt_write_from_ARR = False End Function
это у меня пользовательская функция - как хотите так и передавайте. в нее данные. Можно управляющим макросом, можно в листе формулу написать - см. пример - в зеленой ячейке формула, и макрос отдельно для сохранения данных до последней строки и столбца.
Очень благодарен за предоставленный макрос! Подробнее я объяснить пока не могу, т.к. сам не до конца понимаю, что нужно)). В ближайшее время уточню и обязательно дополню свой вопрос. Только тему пока не закрывайте пожалуйста...
это у меня пользовательская функция - как хотите так и передавайте. в нее данные. Можно управляющим макросом, можно в листе формулу написать - см. пример - в зеленой ячейке формула, и макрос отдельно для сохранения данных до последней строки и столбца.
Очень благодарен за предоставленный макрос! Подробнее я объяснить пока не могу, т.к. сам не до конца понимаю, что нужно)). В ближайшее время уточню и обязательно дополню свой вопрос. Только тему пока не закрывайте пожалуйста...Noober89
Здравствуйте. У меня макрос уже выделяет нужную область и копирует в буфер обмена. Мне нужно дописать его, чтобы он это выделение вставлял в существующий файл ..\PRO100\Cutting%203\SampleTextFile.tc3 который фактически является просто текстовым. При вставке он должен затереть предыдущие данные. Не мог бы мне кто либо помочь.
Здравствуйте. У меня макрос уже выделяет нужную область и копирует в буфер обмена. Мне нужно дописать его, чтобы он это выделение вставлял в существующий файл ..\PRO100\Cutting%203\SampleTextFile.tc3 который фактически является просто текстовым. При вставке он должен затереть предыдущие данные. Не мог бы мне кто либо помочь.meshkoff05