Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Выгрузка из excel в текстовый документ
 
#1
12.12.2009 15:24:08
Уважаемые специалисты  по vbа, подскажите, пожалуйста, каким образом написать макрос по циклической выгрузке данных из excel в файл текстового формата.
 
 
 
#2
12.12.2009 16:29:16
Экспорт выделенного диапазона в txt-файл в ту же папку, что и файл-источник:  
 
Sub ExportRange()  
   Dim Filename As String  
   Dim NumRows As Long, NumCols As Integer  
   Dim r As Long, c As Integer  
   Dim Data  
   Dim ExpRng As Range  
 
   Set ExpRng = Selection  
   NumCols = ExpRng.Columns.Count  
   NumRows = ExpRng.Rows.Count  
   Filename = ThisWorkbook.Path & "\textfile.txt"  
   Open Filename For Output As #1  
       For r = 1 To NumRows  
           For c = 1 To NumCols  
               Data = ExpRng.Cells(r, c).Value  
               If IsNumeric(Data) Then Data = Val(Data)  
               If IsEmpty(ExpRng.Cells(r, c)) Then Data = ""  
               If c <> NumCols Then  
                   Write #1, Data;  
               Else  
                   Write #1, Data  
               End If  
           Next c  
       Next r  
   Close #1  
End Sub
 
 
 
#3
12.12.2009 22:28:41
Выгруженные строки почему-то закавычиваются в начале и конце. Как это можно исправить? Еще раз большое спасибо за помощь
 
 
 
#4
13.12.2009 12:12:57
Попробуй в ворде пройтись "НАЙТИ И ЗАМЕНИТЬ"
 
 
 
#5
13.12.2009 14:14:18
{quote}{login=finic2000}{date=12.12.2009 10:28}{post}Выгруженные строки почему-то закавычиваются в начале и конце. {/post}{/quote}  
Это происходит из-за того, что в первоначальном Selection есть пустые ячейки
 
 
 
#6
13.12.2009 21:28:23
Я специально проверил выделение. Выделяю всего 2 ячейки для проверки, выгруженные строки все-равно закавычиваются.  
 
И еще вопрос: как сделать так, чтобы с определенной периодичностью  (например,3 сек) происходила эта выгрузка в txt-файл?  
 
Большое спасибо за помощь!
 
 
 
#7
13.12.2009 22:12:23
Dim След  
 
Sub Экспорт()  
   ........ основной код!  
 
'   Запускает следующее событие через 3 секунды после настоящего  
   След = Now + TimeValue("00:00:03")  
   Application.OnTime След, "Экспорт"  
End Sub  
 
Sub Останов()  
  On Error Resume Next  
  Application.OnTime След, "Экспорт", , False  
End Sub
 
 
 
#8
14.12.2009 22:32:45
Все заработало, но, к сожалению проблема с кавычками осталась. Не знаете, как решить?
 
 
 
#9
15.12.2009 01:04:46
Судя по-всему, эти кавычки - какая-то  системная чепуха.  
У меня 'закавычиваются' именно текстовые ячейки, с числами все нормально - они идут ч/з запятую.  
Я думаю, надо копать глубже...
 
 
 
#10
15.12.2009 06:26:24
{quote}{login=finic2000}{date=12.12.2009 03:24}{thema=Выгрузка из excel в текстовый документ}{post}Уважаемые специалисты  по vbа, подскажите, пожалуйста, каким образом написать макрос по циклической выгрузке данных из excel в файл текстового формата.{/post}{/quote}  
А если просто через .SaveAs Filename:="zzzzzz", FileFormat:=xlCSV, CreateBackup:=False......?  
c FileFormat можно поэкспериментироватью
 
 
 
#11
15.12.2009 06:59:00
{quote}{login=аналитик}{date=15.12.2009 01:04}{post}Судя по-всему, эти кавычки - какая-то  системная чепуха...{/post}{/quote}  
Кстати, если вручную откопипровать в текстовый файл выделенный фрагмент, то кавычки не появляются
 
 
 
#12
15.12.2009 07:00:09
{quote}{login=Nicks}{date=15.12.2009 06:26}{thema=Re: Выгрузка из excel в текстовый документ}{post}А если просто через .SaveAs Filename:="zzzzzz", FileFormat:=xlCSV, CreateBackup:=False......?  
c FileFormat можно поэкспериментироватью{/post}{/quote}  
А в какую часть кода поставить эту строку?
 
 
 
#13
15.12.2009 08:36:09
Ну перед .SaveAs та книга которую хотите сохранить. Либо по индексу, либо по назвнию. Либо ActiveWorkbook. Как требуется
 
 
 
#14
15.12.2009 10:22:10
{quote}{login=Nicks}{date=15.12.2009 08:36}{thema=}{post}Ну перед .SaveAs та книга которую хотите сохранить. Либо по индексу, либо по назвнию. Либо ActiveWorkbook. Как требуется{/post}{/quote}  
 
Вас не затруднит написать код целиком если файл с выгрузкаой находится в той же папке что и эксель-файл и называется "файл.txt"?
 
 
 
#15
15.12.2009 10:42:58
{quote}{login=finic2000}{date=14.12.2009 10:32}{thema=Заработало}{post}Все заработало, но, к сожалению проблема с кавычками осталась. Не знаете, как решить?  
{/post}{/quote}  
 
Попробуйте изменить    
Write #1, Data;  
 
например на  
Print #1, Data, ;  
или  
Print #1, Data & " ";  
 
Всё зависит от того в каком виде хотите видеть информацию.
 
 
 
#16
15.12.2009 16:37:48
Попробывал оба варианта. к сожалению, кавычит, все равно
 
 
 
#17
15.12.2009 16:44:38
А ты оба Write-а поменял?  
Я заменил на Print (Виталий - спасибо) и всё - никаких кавычек.
 
 
 
#18
15.12.2009 17:17:25
Извините, не сразу заметил второй write. Теперь работает, это просто здорово Теперь можно двигаться вперед! Всем принимавшим участие в решении моей проблемы большое спасибо!
 
 
 
#19
16.12.2009 10:59:07
{quote}{login=}{date=15.12.2009 10:22}{thema=Re: }{post}{quote}{login=Nicks}{date=15.12.2009 08:36}{thema=}{post}Ну перед .SaveAs та книга которую хотите сохранить. Либо по индексу, либо по назвнию. Либо ActiveWorkbook. Как требуется{/post}{/quote}  
 
Вас не затруднит написать код целиком если файл с выгрузкаой находится в той же папке что и эксель-файл и называется "файл.txt"?{/post}{/quote}  
 
Как пример - макрос сохраняет в CSV все файлы EXCEL в папке wDir    
Dim wDir As String  
Dim cvName As String  
'  With Application.FileDialog(msoFileDialogFolderPicker)  
   wDir = "d:\temp"  
'  End With  
 
 Set fs = Application.FileSearch  
 Application.ScreenUpdating = False  
       ' Application.Screen.MousePointer = vbHourglass  
With fs  
   .LookIn = wDir  
   .FileType = msoFileTypeExcelWorkbooks  
   .Execute  
End With  
  If fs.Execute() > 0 Then  
       MsgBox "Найдено " & fs.FoundFiles.Count & " файлов."  
       For i = 1 To fs.FoundFiles.Count  
            Application.Workbooks.Open Filename:=fs.FoundFiles(i), ReadOnly:=True  
            For Each w In Workbooks  
                  If w.FullName = fs.FoundFiles(i) Then  
                     cvName = Left(fs.FoundFiles(i), Len(Trim(fs.FoundFiles(i))) - 4) & "_csv.csv"  
                      w.SaveAs Filename:=cvName, FileFormat:=xlCSV, CreateBackup:=False, TextCodepage:=1251  
                      w.Close savechanges:=True  
                 End If  
           Next w  
        Next i  
   Else  
       MsgBox "Файлов EXCEL не найдено."  
   End If  
     ' Screen.MousePointer = vbDefault  
Application.ScreenUpdating = True
 
 
 
#20
31.05.2010 13:36:42
В коде из сообщения 2 следует заменить строку    
If IsNumeric(Data) Then Data = Val(Data)  
на  
If IsNumeric(Data) Then Data = Trim(Str(Data)) при использовании print вместо write.  
Иначе появляется пробел в txt-файле перед любым числовым значением на листе Excel.
 
 
 
Страницы: 1
Читают тему
Наверх