Макросом разнести данные из исходной формы в плоский файл - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д