Макросом разнести данные из исходной формы в плоский файл - VBA
Формулировка задачи:
Ребята всем привет, помогите реализовать - есть исходная форма статьи оплат, в разрезе организаций, счетов/касс,контрагентов, причем под каждой статьей может быть разное кол-во контрагентов, необходимо подтянуть данные из этой формы в плоский файл. Я слаба в VBA, ребята помогите девчонке, очень надо. Файл приложила.
Решение задачи: «Макросом разнести данные из исходной формы в плоский файл»
textual
Листинг программы
- Option Explicit
- Sub tt()
- Dim ra As Range, i&, ii&, t$, tt$, x&
- Set ra = Range([AP1], Range("B" & Rows.Count).End(xlUp))
- ReDim b(1 To ra.Rows.Count * ra.Columns.Count, 1 To 6)
- x = x + 1
- b(x, 1) = "Дата"
- b(x, 2) = "Сумма"
- b(x, 3) = "Статья ДДС"
- b(x, 4) = "Контрагент"
- b(x, 5) = "Организация"
- b(x, 6) = "Касса / Счет"
- For i = 5 To ra.Rows.Count
- If ra.Cells(i, 1).IndentLevel = 0 Then
- t = ra.Cells(i, 1)
- Else: tt = ra.Cells(i, 1)
- For ii = 2 To ra.Columns.Count
- If ra.Cells(i, ii) > 0 Then
- If ra.Cells(3, ii) <> "Итог" Then
- x = x + 1
- b(x, 1) = ra.Cells(3, ii)
- b(x, 2) = ra.Cells(i, ii)
- b(x, 3) = t
- b(x, 4) = tt
- b(x, 5) = ra.Cells(2, ii)
- b(x, 6) = ra.Cells(1, ii)
- End If
- End If
- Next
- End If
- Next
- With Workbooks.Add(1).Sheets(1).Cells(1).Resize(x, 6)
- .Columns(2).NumberFormat = "#,##0.00"
- .Value = b
- .EntireColumn.AutoFit
- End With
- End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д