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

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


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

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

8   голосов , оценка 4.375 из 5
Похожие ответы