Расширение существующего кода VBA с помощью условий CountIf

Question

Я пытаюсь понять, как расширить приведенный ниже код со следующими условиями counttif:

• Если строка в Workbbook 1 (wbSource) имеет значения в Столбец H = "01.January" и столбец AD = <50 </strong>, затем подсчитайте и введите результат в ячейку B8 на листе 2 Рабочей книги 2 (ThisWorkbook ) после проверки всего wbSource .
• Если строка в wbSource имеет значения Столбец H = «01.January» и Столбец AD => 50 и <100 </strong>, тогда подсчитайте и введите результат. в ячейке B9 на листе 2 ThisWorkbook после проверки всего wbSource.
• Если строка в wbSource имеет значения Column H = "01. Январь »и столбец AD => 100 , затем подсчитайте и введите результат в ячейку B10 на листе 2 ThisWorkbook после проверки всего wbSource.

Это следует повторять каждый месяц.

Вся концепция основана на пользовательской форме с файлом ex Функция plorer, в которой пользователь может выбрать файл Excel и автоматически оценить его на основе условий avarage_cal c и counttif, нажав на кнопку команды. Вот почему мне это нужно как VBA.

Есть идеи, как добавить функцию counttif на основе приведенных выше условий в качестве дополнения к моему существующему коду?

Private Sub CommandButton2_Click() ' update averages
     Const YEAR = 2019

    ' open source workbook
    Dim fname As String, wbSource As Workbook, wsSource As Worksheet
    fname = Me.TextBox1.Text

    If Len(fname) = 0 Then
       MsgBox "No file selected", vbCritical, "Error"
       Exit Sub
    End If

    Set wbSource = Workbooks.Open(fname, False, True) ' no link update, read only
    Set wsSource = wbSource.Sheets("Sheet1") ' change to suit

    Dim wb As Workbook, ws As Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Table 2") '

    ' scan down source workbook calc average
    Dim iRow As Long, lastRow As Long
    Dim sMth As String, iMth As Long
    Dim count(12) As Long, sum(12) As Long

    lastRow = wsSource.Cells(Rows.count, 1).End(xlUp).Row
    For iRow = 1 To lastRow

        If IsDate(wsSource.Cells(iRow, 8)) _
            And IsNumeric(wsSource.Cells(iRow, 30)) Then

            iMth = Month(wsSource.Cells(iRow, 8))   ' col H
            sum(iMth) = sum(iMth) + wsSource.Cells(iRow, 30) ' Col AD
            count(iMth) = count(iMth) + 1 '

        End If
    Next

    ' close source worbook no save
    wbSource.Close False

    ' update Table 2 with averages
    With ws.Range("A3")
    For iMth = 1 To 12
        .Offset(0, iMth - 1) = MonthName(iMth) & " " & YEAR
        If count(iMth) > 0 Then
            .Offset(1, iMth - 1) = sum(iMth) / count(iMth)
            .Offset(1, iMth - 1).NumberFormat = "0.0"
        End If
    Next
    End With


    Dim msg As String
    msg = iRow - 1 & " rows scanned in " & TextBox1.Text
    MsgBox msg, vbInformation, "Table 2 updated"

End Sub

Wb result sheet2

wb.Source Sheet1

Answer 1

Думаю, я понимаю, что вы ищете, простите, если я полностью упустил суть. Вы должны иметь возможность поместить это в конец существующего кода. Несколько примечаний:

• Поскольку я предполагаю, что вы не хотите, чтобы значения каждого месяца перезаписывали значения предыдущего месяца, я сделал январь go в столбце B, февраль в C , et c. (это часть 1+x, если вы хотите ее изменить).

• EDIT: l oop от 1 до 12 в паре с функцией m = будет l oop через диапазоны дат, которые вы ищете.

• Я также изменил формулы для второй и третьей функций, чтобы у вас не было перекрытия (поскольку 1 имел <= 50, а 2 имел > = 50, поэтому все, что равно 50, появилось бы в обоих).

  Dim x as Long
  Dim m as Date
  
  For x = 1 To 12
  
      m = CDate(x & "/1/2019")
  
      ws.Cells(8, 1 + x) = _
          Application.WorksheetFunction.CountIfs(wsSource.Columns(8), m, _
          wsSource.Columns(30), "<=" & 50)
  
      ws.Cells(9, 1 + x) = _
          Application.WorksheetFunction.CountIfs(wsSource.Columns(8), m, _
          wsSource.Columns(30), ">" & 50, wsSource.Columns(30), "<=" & 100)
  
      ws.Cells(10, 1 + x) = _
          Application.WorksheetFunction.CountIfs(wsSource.Columns(8), m, _
          wsSource.Columns(30), ">" & 100)
  
  Next x