Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сохранение 5 столбцов из excel в txt файл с помощью vba
 
#1
13.01.2014 08:14:36
Гуру, вновь нужна ваша помощь))
Задача проста - макросом делаю 5 столбцов данных и надо их сохранить в txt файл для загрузки в спец. софт. Можно и руками, конечно, но больно уж хочется красоту навести)
Из рабочих у меня пока только такой вариант:

Код
Range("I1:M" & Cells(Rows.Count, 10).End(xlUp).Row).Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs filename:="C:\123\123.txt", FileFormat:=xlUnicodeText, CreateBackup:=False
ActiveWindow.ActiveSheet.Delete
Наверное, этот код делает вам больно))) Хотя если добавить строку сохранения в *.xlsm то все будет, в принципе, хорошо) Пытался еще вот так, по найденному в гугле способу, но не получилось адаптировать под свои нужды:

Код
Set ra = Range("I1:M" & Cells(Rows.Count, 10).End(xlUp).Row) '.Resize(, 11)
arr = ra.Value    
Open ActiveWorkbook.Path & "\test.txt" For Output As 1
Write #1, arr
Close #1


Open "c:\1.txt" For Output As #1
For i = LBound(arr) To UBound(arr)
        For j = 1 To 5
            Print #1, arr(i, j)
        Next j
Next i
Close #1
помогите, пожалуйста)
Изменено: peat - 14.01.2014 00:56:31 (пыщь)
 
 
 
#2
13.01.2014 08:49:29
как должен выглядеть .txt  файл, или это не имеет значения?
Если очень захотеть - можно в космос полететь ;)
 
 
 
#3
13.01.2014 08:52:04
lexey_fan

Имеет) Должен выглядеть так же, как если бы эти ячейки в 5 столбцах были бы выделены, копированы и вставлены в пустой тхт. Собственно, рабочий вариант это и делает)
 
 
 
#4
13.01.2014 18:06:39
Цитата
Должен выглядеть так же, как если бы эти ячейки в 5 столбцах были бы выделены, копированы и вставлены в пустой тхт
То есть вам нужен типа CSV с текстом без кавычек и с табом-разделителем?
Можно пример исходных данных? И образец правильных данных (в текстовом виде) для этого вашего "спецсофта".
А то я всё никак не соберусь доделать экспорт в CSV, хоть будет на ком потренироваться  :)
 
 
 
#5
13.01.2014 18:13:56
AndreTM к сожалению, я сейчас не располагаю примером, будет только завтра)
Но все верно - разделитель таб. про csv ничего сказать не могу, прога хавает либо .dat либо .txt, это гидродинамический симулятор, они все хавают подобные форматы.
Заполните 5 столбцов любым содержанием, сохраните как тхт файл или копируйте все 5 столбцов - получите нужный мне тхт)
Спасибо за ссылку, завтра проведу тесты со своими файлами.

Совсем забыл сказать - кавычек у меня там нет, разделитель целой и дробной части - точка. Мои файлы, наверное, не очень интересны вам для эксперимента т.к. просты аки 3 копейки))
Изменено: peat - 13.01.2014 18:34:23 (грумс)
 
 
 
#6
13.01.2014 20:43:02
CSV - это так, для обозначения вида вывода. Текст - он и в Африке текст. А расширение вы можете задать любое, если укажете имя выходного файла.
В целом же, думаю, процедура вам подойдёт. Единственное - если в столбцах есть "дата-время", то надо бы провести предварительное преобразование в текст нужного формата. Поэтому я и спрашивал про пример реальных данных.
Если что - пишите в ЛС здесь или там...
 
 
 
#7
14.01.2014 08:43:44
AndreTM что-то не очень корректно работает ваш код, к сожалению((
прикрепляю ваш файл с фрагментом данных, которые мне надо сохранить в тхт и прикрепляю тот тхт, который нужно мне получить.
Ваш макрос по сути делает то же, что и мой - мой, правда, поступающую дату никак не обрабатывает))
Я думал, мб есть какой-то хитрющий способ записи целого например столбца в тхт, мб прям одной командой...Видимо, нет)
 
 
 
#8
14.01.2014 09:08:50
Надеюсь AndreTM не заругает  :)
Если очень захотеть - можно в космос полететь ;)
 
 
 
#9
14.01.2014 09:32:00
lexey_fan уже ближе, но, почему-то отрубается первый столбец, а в первую строку какая-то ересь выводится)
 
 
 
#10
14.01.2014 09:58:52
Используйте кнопочку пример 1
Если очень захотеть - можно в космос полететь ;)
 
 
 
#11
14.01.2014 10:02:19
lexey_fan теперь только дата перевернута)))  2013.12.01 вместо 01.12.2013 - изменю тип даты и все будет ок)
спасибо вам за труды!
Изменено: peat - 14.01.2014 10:04:57 (123)
 
 
 
#12
14.01.2014 11:10:55
спасибо автору: AndreTM , тут полностью его заслуга :D
Если очень захотеть - можно в космос полететь ;)
 
 
 
#13
14.01.2014 14:15:58
Используйте следующий код:
Код
Sub Test()

    ' Заменяем даты их символьным представлением
    r = 1
    While Len(Cells(r, 1)) Or Len(Cells(r + 1, 1))
        Cells(r, 1).Value = CStr(Cells(r, 1).Value)
        r = r + 1
    Wend

    ' Удаляем лишние строки
    r2 = Sheets("Пример").UsedRange.Rows.Count
    If r2 > r Then Cells(r, 1).Resize(r2 - r1 + 1).EntireRow.Delete

    ' Экспортируем: разделитель - табуляция, заголовка - нет
    ExportSheet2CSV cFileName:=("Пример.txt"), cDelimiter:=vbTab, vCutHeader:=0

End Sub
 
 
 
#14
14.01.2014 14:29:48
Можно поступить проще - использовать одну готовую процедуру под нужный вам вид (предварительно даты можно не конвертировать - поменяются в ней):
Код
Sub Export2txt()
    
    cOutAll = ""
    
    nLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
    nLastCol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
    For i = 1 To nLastRow
        cOut = ""
        For j = 1 To nLastCol
            cOut = cOut & vbTab & CStr(Cells(i, j))
        Next
        cOutAll = cOutAll & Mid(cOut, 2) & vbCrLf
    Next
    
     On Error Resume Next: Err.Clear
     Dim fso As Object, ts As Object
     Set fso = CreateObject("scripting.filesystemobject")
     Set ts = fso.CreateTextFile(ActiveWorkbook.Path & "\" & "Test.txt", True)
     ts.Write cOutAll: ts.Close
     Set ts = Nothing: Set fso = Nothing
    
End Sub
 
 
 
#15
16.01.2014 11:05:54
я, все-таки, поступил более проще и надежнее - но только для моего случая:


Код
Private Sub Copy_to_file_Click()
Application.ScreenUpdating = False
Range("I1:M" & Cells(Rows.Count, 10).End(xlUp).Row).Copy
copy_to_txt Filename:=(ActiveSheet.Name + "123.txt")
Application.ScreenUpdating = True
End Sub


Public Sub copy_to_txt(ByVal Filename As String)
Dim NewWB As Workbook
Set NewWB = Workbooks.Add
ActiveSheet.Paste
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Filename, FileFormat:=xlText, CreateBackup:=False, Local:=True
Application.DisplayAlerts = True
NewWB.Close SaveChanges:=False
End Sub
Но вам огромное спасибо за помощь, узнал пару приемов и все такое)
Вообще, меня интересовала как бы "технология" записи в тхт. Получается, что кроме

Код
Set ts = fso.CreateTextFile(ActiveWorkbook.Path & "\" & "Test.txt", True)
     ts.Write cOutAll: ts.Close
ничего и нет. Ну еще принт и мой способ saveas txt...
 
 
 
#16
15.09.2020 12:15:47
Вот эта программа работает на перенос с Excel в блокнот строк и столбцов
скопировать строку в excel и вставить в txt через visual basic


Function Export2txt(fn As String, Rg As Range)    
   cOutAll = ""
   
 
   nLastRow = Rg.Rows.Count
   nLastCol = Rg.Columns.Count
   For i = 1 To nLastRow
       cOut = ""
       For j = 1 To nLastCol
           cOut = cOut & vbTab & CStr(Rg.Cells(i, j))
       Next
       cOutAll = cOutAll & Mid(cOut, 2) & vbCrLf
   Next
   
    On Error Resume Next: Err.Clear
    Dim fso As Object, ts As Object
    Set fso = CreateObject("scripting.filesystemobject")
    Set ts = fso.OpenTextFile(fn, 8, True)
       
    ts.Write (cOutAll)
    ts.Close
    Set ts = Nothing
    Set fso = Nothing
    Return
   
End Function

Sub Ìàêðîñ1()
'
' Ìàêðîñ1 Ìàêðîñ
'

'
 

Dim rg1 As Range, res, a As String
a = CStr("D:\" & Worksheets("Exp").Cells(1, 1).Value)
Set rg1 = Worksheets("Exp").Range(Worksheets("Exp").Cells(6, 4), Worksheets("Exp").Cells(10, 5))

res = Export2txt(fn:=a, Rg:=rg1)

End Sub
Изменено: Олег Дудкин - 15.09.2020 12:24:03
 
 
 
Страницы: 1
Читают тему
Наверх