Макросом разнести данные из исходной формы в плоский файл - 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