Личная бухгалтерия

                ReportName = ReportName & " за период " _

                    & Format(Cells(2, 1).Value, "Short Date") _

                    & " - " & Format(Cells(4, 1).Value, "Short Date")

            Case 4

                BeginPeriod = DateSerial(1990, 1, 2)

                .Cells(5, 7).AutoFilter Field:=7, Criteria1:="Долги и займы"

                FirstCol = 2

                LastCol = 6

                ReportName = "Должники на конец даты " _

                    & Format(Cells(4, 1).Value, "Short Date")

                ReportName2 = "Займы на конец даты " _

                    & Format(Cells(4, 1).Value, "Short Date")

            Case 5

                BeginPeriod = DateSerial(1990, 1, 2)

                .Cells(5, 7).AutoFilter Field:=7, Criteria1:="Денежные накопления"

                FirstCol = 2

                LastCol = 6

                ReportName = ReportName & " на конец даты " _

                    & Format(Cells(4, 1).Value, "Short Date")

            Case Else

'                MsgBox BeginPeriod

        End Select

    End With

    With Sheets("_журнал_")

        .Cells(2, 1).Value = BeginPeriod

        .Cells(4, 1).Value = Cells(4, 1).Value

        '

        DateFilter

        '

        LastRowNumber = .Cells(5, 1).CurrentRegion.Rows.Count

        Range(.Cells(5, FirstCol), .Cells(LastRowNumber, LastCol)).Copy

    End With

    Sheets("Temporal").Paste

    If LiInd >= 4 Then

        With Sheets("Temporal")

            LastRowNumber = .Cells(1, 1).CurrentRegion.Rows.Count

            If LastRowNumber < 2 Then

                Exit Sub

            End If

            For i = 2 To LastRowNumber

                If .Cells(i, 1).Value = " +" Then

                    .Cells(i, 2).Value = -.Cells(i, 2).Value

                End If

            Next

        End With

        If LiInd = 4 Then

            '

            Range("Temporal!D1").Sort Key1:=Range("Temporal!E2"), Order1:=xlAscending, Key2:=Range("Temporal!D2") _

                , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _

                False, Orientation:=xlTopToBottom

            With Sheets("Temporal")

                '

                .Cells(1, 6).Value = "Сумма"

                .Cells(1, 2).Value = "БывшаяСумма"

                SummaArt = 0

                PrevValue = "a2b6r0))&akadabra"

                For i = 2 To LastRowNumber + 1

                    If .Cells(i, 4).Value <> PrevValue Then

                        PrevValue = .Cells(i, 4).Value

                        If i > 2 Then

                            .Cells(i - 1, 6).Value = SummaArt

                            SummaArt = 0

                        End If

                    End If

                    SummaArt = SummaArt + .Cells(i, 2).Value

                Next

                '

                i = 2

                DoCounter = 1

                продолжим = True

                Do While продолжим

                    If IsEmpty(.Cells(i, 4).Value) Then

                        продолжим = False

                        Exit Do

                    End If

                    CelVal = .Cells(i, 6).Value

                    If IsEmpty(CelVal) Then

                        .Rows(i).Delete

                    ElseIf CelVal = 0 Then

                        .Rows(i).Delete

                    Else

                        '

                        If CelVal < 0 Then

                            .Cells(i, 6).Value = -CelVal

                            .Cells(i, 1).Value = " -"

                        Else

                            .Cells(i, 1).Value = " +"

                        End If

                        '

                        i = i + 1

                    End If

                    DoCounter = DoCounter + 1

                    If DoCounter > 60000 Then

                        MsgBox "Странность в макросе: принудительный выход из зацикливания"

                        Exit Do

                    End If

                Loop

               

                '

            End With

            '

        End If

    End If

End Sub 

Sub ПриходыРасходыДолгиЗаймы()

    Dim SSource As Range

   

    If LiInd = 1 Then

    '

    With Sheets("Temporal")

        НачальнаяСумма = .Cells(2, 7).Value

        If Trim(.Cells(2, 1).Value) = "+" Then

            НачальнаяСумма = НачальнаяСумма - .Cells(2, 2).Value

        Else

            НачальнаяСумма = НачальнаяСумма + .Cells(2, 2).Value

        End If

        LastRow = .Cells(1, 1).CurrentRegion.Rows.Count

        КонечнаяСумма = .Cells(LastRow, 7)

    End With

    '

    End If

    '

    ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _

        SourceString, TableDestination:="R9C1", TableName:="НеВажно", _

        SaveData:=False

    With ActiveSheet.PivotTables(1)

        .EnableDrilldown = False

        .SaveData = False

    End With

    If Подробный Then

        If LiInd = 1 Then

            ActiveSheet.PivotTables(1).AddFields RowFields:= _

                Array("Категория", "Группа", "Статья"), PageFields:=" +/-"

        ElseIf LiInd = 4 Then

            ActiveSheet.PivotTables(1).AddFields RowFields:= _

                Array("Группа", "Статья"), PageFields:=" +/-"

        End If

    Else

        ActiveSheet.PivotTables(1).AddFields RowFields:= _

            Array("Группа"), PageFields:=" +/-"

    End If

    ActiveSheet.PivotTables(1).PivotFields("Сумма").Orientation = _

        xlDataField

    ActiveSheet.PivotTables(1).PivotFields("Данные"). _

        PivotItems(1).Name = ReportName

    ActiveSheet.PivotTables(1).PivotSelect "", xlOnlyData

        Selection.NumberFormat = "#,##0.00"

    '

    ПлюсЕсть = False

    '

    МинусЕсть = False

    '

    With ActiveSheet.PivotTables(1).PivotFields(" +/-")

        For x = 1 To .PivotItems.Count

            If .PivotItems(x).Name = " +" Then

                ПлюсЕсть = True

            ElseIf .PivotItems(x).Name = " -" Then

                МинусЕсть = True

            End If

        Next

    End With

    '

    If ПлюсЕсть Then

         ActiveSheet.PivotTables(1).PivotFields(" +/-").CurrentPage = _

            " +"

    End If

    '

    КолРядовБезШапки2 = ActiveSheet.PivotTables(1).RowRange.Rows.Count

    ПослРяд = 7 + 2 + КолРядовБезШапки2

    Rows("7:" & ПослРяд).Copy

    Cells(ПослРяд + 1, 1).Select

    ActiveSheet.Paste

    ' 

    If МинусЕсть Then

        ActiveSheet.PivotTables(1).PivotFields(" +/-").CurrentPage = _

            " -"

    End If

    '

    ActiveSheet.PivotTables(1).PivotFields("Данные"). _

        PivotItems(1).Name = ReportName2

    Rows("7:7").Select

    Selection.EntireRow.Hidden = True

    ПослРяд1стр = CStr(ПослРяд + 1)

    СдвигТаблиц = ПослРяд + 1 - 7

    Rows(ПослРяд1стр & ":" & ПослРяд1стр).Select

    Selection.EntireRow.Hidden = True

For TableNum = 1 To 2

   ActiveSheet.PivotTables(TableNum).PivotSelect "", xlDataAndLabel

    With Selection

        .Font.Name = "Arial"

        .Font.Bold = True

        .Font.Size = 12

        .Interior.ColorIndex = ColorInd

    End With

    '

    If Подробный Then

        ActiveSheet.PivotTables(TableNum).PivotSelect _

            "Статья", _

            xlDataAndLabel

        With Selection.Font

            .Size = 10

        End With

    End If

    '

    ActiveSheet.PivotTables(TableNum).PivotSelect "", xlOrigin

     With Selection.Interior

        .ColorIndex = 42

        .Pattern = xlSolid

    End With

    '

Next

'

КолРядовБезШапки1 = ActiveSheet.PivotTables(1).RowRange.Rows.Count

'

РядКонечнойСуммы = 13 + КолРядовБезШапки1 + КолРядовБезШапки2

If Подробный Then

    ВтораяКолонка = 4

Else

    ВтораяКолонка = 2