Sumif, возвращающий ту же стоимость - PullRequest
3 голосов
/ 18 марта 2019

Я получил ниже таблицу, которую мне нужно заполнить данными, основанными на текущем месяце (Рабочая таблица "PR"):

enter image description here

ПримерНеобработанные данные выглядят так (Рабочая таблица "CSV Data PR"):

enter image description here

У меня есть две проблемы:

  • Только SumIFработает для первого региона, все остальные принимают те же данные.Например, правильные данные показаны ниже февраля.
  • По какой-то причине он полностью опускает формулу ..., хотя должен остановиться на Западной Европе.Я не уверен, почему это так.

На основе следующего фрагмента кода:

Sub TableDataTest()

    Dim rngHdrFound, rngHdrFound2, findrng, USDRng, RegionRNG, rngHeaders, RngHeadersOutPut As Range
    Dim x, y As Worksheet
    Dim ThisMonth As Date
    Dim index As Variant

    Application.ScreenUpdating = False

    'Set Worksheets
    Set x = ThisWorkbook.Sheets("CSV Data PR")
    Set y = ThisWorkbook.Sheets("PR")
    index = y.Range("D8")
    ThisMonth = Format(Date, "MM/YYYY")

    'Set HeaderRow
    Const ROW_HEADERS As Integer = 1

    Set rngHeaders = Intersect(Worksheets("CSV Data PR").UsedRange, Worksheets("CSV Data PR").Rows(ROW_HEADERS))
    Set RngHeadersOutPut = y.Range("6:6")
    Set rngHdrFound = rngHeaders.Find("In USD")
    Set rngHdrFound2 = rngHeaders.Find("Region")
    Set findrng = RngHeadersOutPut.Find(What:=ThisMonth, LookIn:=xlFormulas, lookat:=xlWhole)
    Set USDRng = Range(rngHdrFound.Offset(1), rngHdrFound.End(xlDown))
    Set RegionRNG = Range(rngHdrFound2.Offset(1), rngHdrFound2.End(xlDown))

    'Find CurrentMonth + Range
    With y
        If findrng Is Nothing Then
            MsgBox "Error, unable to match " & ThisMonth & " in the specified range", vbCritical
        Exit Sub
        Else
            findrng.Offset(2, 0).Resize(Selection.Rows.Count + 8).Value = Application.WorksheetFunction.SumIf(RegionRNG, "=" & index, USDRng)
        End If
    End With

    Application.ScreenUpdating = True

End Sub

1 Ответ

2 голосов
/ 18 марта 2019

Вы можете попробовать это:

Option Explicit
Sub TableDataTest()

    Dim ws As Worksheet, wsData As Worksheet, MonthCol As Integer, ThisMonth As Date, C As Range, _
    x As Integer, y As Integer

    x = 2 'Number of the column with the region
    y = 3 'Number of the column with the data to sum

    With ThisWorkbook
        Set ws = .Sheets("PR")
        Set wsData = .Sheets("CSV Data PR")
    End With
    ThisMonth = Format(wsData.Range("C2"), "MM/YYYY")
    With ws
        MonthCol = .Cells.Find(ThisMonth, LookIn:=xlFormulas, lookat:=xlWhole).Column
        For Each C In .Range(.Cells(3, Col), .Cells(11, Col))
            C = Application.SumIf(wsData.Columns(x), .Cells(C.Row, 1), wsData.Columns(y))
        Next C
    End With

End Sub

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

PS: я предполагаю, что таблица начинается со строки 3 и столбца A, в противном случае измените начальную строку 3 в диапазоне For Each C и критерии внутри столбца принятия суммирования1.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...