Создание итога с VBA - PullRequest
Новая
       13

Создание итога с VBA

0 голосов
/ 18 мая 2018

В настоящее время я пытаюсь создать итоговую, минимальную, максимальную и среднюю таблицу внизу листа.Я также хотел бы, чтобы «таблица» начиналась на две ячейки ниже последней заполненной ячейки.

Я загружаю различные объемы данных, которые могут быть за один день или целых 100. 

Sub max()

Dim N As Long

N = Cells(Rows.COUNT, "B").End(xlUp).Row

'Cells(N + 1, "B").Formula = "=MAX(B$13:B$44" & N & ")" <-COMMENTED OUT / THIS WORKS

Cells(N + 1, "B").Formula = "=IF(COUNT(B$13:B$44)=0,"",MAX(B$13:B$44))" & N & ")"

End Sub

Это то, что я имею до сих пор.Я получаю ошибку 1004 и понимаю, что неправильно вызываю переменную.Мне также нужно будет сделать это около 200 столбцов.Куда я иду не так?

Ответы [ 3 ]

0 голосов
/ 18 мая 2018

Вы можете использовать Chr(34), чтобы добавить его в формулу. 

Cells(N + 1, "B").Formula = "=IF(COUNT(B$13:B$44)=0,"& Chr(34) & Chr(34) &",MAX(B$13:B$44))" & N & ")"
0 голосов
/ 18 мая 2018

РЕДАКТИРОВАТЬ: Обновление для несмежных таблиц.

Это предполагает, что у вас нет ничего ниже или справа от таблицы на листе, и что ваша таблица начинается с B13 (заголовки будут строки 12): 

Option Explicit

Public Sub BuildStatsTable()
    Dim lngMaxRow As Long
    Dim lngMaxCol As Long
    Dim lngCol As Long
    Dim strRng As String
    Dim rngLastUsed As Range

    Set rngLastUsed = GetLastRange(Cells(13, 2))
    lngMaxCol = rngLastUsed.Column
    lngMaxRow = rngLastUsed.Row

    For lngCol = 2 To lngMaxCol
        strRng = "R13C" & lngCol & ":R" & lngMaxRow & "C" & lngCol

        Cells(lngMaxRow + 2, lngCol).FormulaR1C1 = "=IF(COUNT(" & strRng & ")=0,"""",SUM(" & strRng & "))"
        Cells(lngMaxRow + 3, lngCol).FormulaR1C1 = "=IF(COUNT(" & strRng & ")=0,"""",MIN(" & strRng & "))"
        Cells(lngMaxRow + 4, lngCol).FormulaR1C1 = "=IF(COUNT(" & strRng & ")=0,"""",MAX(" & strRng & "))"
        Cells(lngMaxRow + 5, lngCol).FormulaR1C1 = "=IF(COUNT(" & strRng & ")=0,"""",AVERAGE(" & strRng & "))"
    Next lngCol
End Sub

Private Function GetLastRange(rngTopLeft As Range) As Range
    Dim rngUsed As Range
    Dim lngMaxRow As Long
    Dim lngMaxCol As Long

    Set rngUsed = Range(rngTopLeft, rngTopLeft.SpecialCells(xlCellTypeLastCell))

    lngMaxRow = rngUsed.Find(What:="*", _
                            After:=rngUsed.Cells(1), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    lngMaxCol = rngUsed.Find(What:="*", _
                            After:=rngUsed.Cells(1), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column

    Set GetLastRange = Cells(lngMaxRow, lngMaxCol)
End Function
0 голосов
/ 18 мая 2018

При попытке использовать VBA для создания формулы, и в этой формуле вы хотите использовать кавычки, вы должны «удвоить»: 

Cells(N + 1, "B").Formula = "=IF(COUNT(B$13:B$44)=0,"""",MAX(B$13:B$44))" & N & ")"
...