Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Экспорт в .txt определенного диапазона по заданным условиям
 
#1
07.10.2019 12:08:36
Добрый день. Форумчане, прошу о помощи, я в VBA совсем не разбираюсь, формулы только немного освоил, и то каряво. Вообщем есть задача выводить в txt заданный диапазон, например E3:P18 (чтобы было не выделением, а именно диапазон был прописан в макросе, чтобы я ручками потом его смог поменять) и еще 3 важных условия: чтобы экспорт сохранял табуляцию, чтобы при экспорте он выкидывал пустые строки (по заданному диапазону) и строки где в столбце "К" есть показание "00:00:00:00".
Во вложении таблица, а также пример, который должен получится в txt. Буду очень благодарен, еще раз спасибо.
 
 
 
#2
07.10.2019 14:09:53
Как-то многострочно вышло...
Код
Sub bbbb()
Dim dt$, a&, b&, c&, aa As Range, bb As Range, cc(), x&
Set bb = ActiveSheet.Range("E3:P18") 'диапазон меняем здесь
c = FreeFile: a = bb.Row
dt = ThisWorkbook.Path & "\" & Replace(Replace(Now, ".", "_"), ":", "_") & ".txt"
For Each aa In bb
  If InStr(aa, "\") Then
    If Len(aa) > x Then x = Len(aa)
  End If
Next
Open dt For Output As #c
  For a = 1 To bb.Rows.Count
    ReDim cc(1 To bb.Columns.Count): b = 1
    For Each aa In Intersect(bb, bb.Rows(a)).Cells
      If InStr(aa, "\") Then
        cc(b) = aa.Value & Space(x - Len(aa)): b = b + 1
      ElseIf InStr(aa.NumberFormat, "yy") Or InStr(aa.NumberFormat, "hh") Then
        cc(b) = Format(aa, aa.NumberFormat): b = b + 1
      Else: cc(b) = aa.Value: b = b + 1
      End If
    Next: dt = Join(cc, "")
    If Len(dt) > 0 And InStr(dt, "\.") < 1 Then Print #c, Join(cc, vbTab)
  Next
Close #c
End Sub
Изменено: Anchoret - 07.10.2019 15:45:04 (укоротил...)
 
 
 
#3
07.10.2019 14:20:01
Код
Sub Save2TxtFile()
  Dim a, fs, tf, r&, c&, s$
  a = Range("E3:P18"):  Set fs = CreateObject("Scripting.FileSystemObject")
  Set tf = fs.CreateTextFile(ThisWorkbook.Path & Application.PathSeparator & "textfile.txt", True)
  For r = 1 To UBound(a)
    If Replace(Replace(a(r, 7), "0", ""), ":", "") <> "" Then
      s = ""
      For c = 1 To UBound(a, 2): s = s & vbTab & a(r, c): Next
      tf.WriteLine Right(s, Len(s) - 1)
    End If
  Next
  tf.Close
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#4
07.10.2019 21:53:38
Друзья! Большое спасибо, оба кода подошли просто идеально!!! Я прямо очень благодарен Вам за помощь  :)  
 
 
 
Страницы: 1
Наверх