Макросом разнести данные из исходной формы в плоский файл - VBA

Узнай цену своей работы

Формулировка задачи:

Ребята всем привет, помогите реализовать - есть исходная форма статьи оплат, в разрезе организаций, счетов/касс,контрагентов, причем под каждой статьей может быть разное кол-во контрагентов, необходимо подтянуть данные из этой формы в плоский файл. Я слаба в VBA, ребята помогите девчонке, очень надо. Файл приложила.

Решение задачи: «Макросом разнести данные из исходной формы в плоский файл»

textual
Листинг программы
  1. Option Explicit
  2.  
  3. Sub tt()
  4. Dim ra As Range, i&, ii&, t$, tt$, x&
  5.  
  6. Set ra = Range([AP1], Range("B" & Rows.Count).End(xlUp))
  7. ReDim b(1 To ra.Rows.Count * ra.Columns.Count, 1 To 6)
  8. x = x + 1
  9. b(x, 1) = "Дата"
  10. b(x, 2) = "Сумма"
  11. b(x, 3) = "Статья ДДС"
  12. b(x, 4) = "Контрагент"
  13. b(x, 5) = "Организация"
  14. b(x, 6) = "Касса / Счет"
  15.  
  16. For i = 5 To ra.Rows.Count
  17.     If ra.Cells(i, 1).IndentLevel = 0 Then
  18.         t = ra.Cells(i, 1)
  19.     Else: tt = ra.Cells(i, 1)
  20.         For ii = 2 To ra.Columns.Count
  21.             If ra.Cells(i, ii) > 0 Then
  22.                 If ra.Cells(3, ii) <> "Итог" Then
  23.                 x = x + 1
  24.                 b(x, 1) = ra.Cells(3, ii)
  25.                 b(x, 2) = ra.Cells(i, ii)
  26.                 b(x, 3) = t
  27.                 b(x, 4) = tt
  28.                 b(x, 5) = ra.Cells(2, ii)
  29.                 b(x, 6) = ra.Cells(1, ii)
  30.                 End If
  31.             End If
  32.         Next
  33.     End If
  34. Next
  35.  
  36. With Workbooks.Add(1).Sheets(1).Cells(1).Resize(x, 6)
  37.     .Columns(2).NumberFormat = "#,##0.00"
  38.     .Value = b
  39.     .EntireColumn.AutoFit
  40. End With
  41. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

8   голосов , оценка 4.375 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы