使用CountIf条件扩展现有的VBA代码

Question

我正试图找出如何使用以下countif条件来扩展下面的代码：

• 如果Workbbook 1（wbSource）]中的一行具有Column H =“ 01.January”和Column AD = <50然后计数并输入结果工作簿2（ThisWorkbook]的工作表2的B8单元格>）wbSource已选中。
• 如果wbSource中的行的值Column H =“ 01.January”，并且然后，在检查整个wbSource之后，将列AD => 50和<100
计数并输入到此工作簿第2页的单元格B9中并将结果输入。
• 如果wbSource中的行具有值Column H =“ 01.January”和Column AD => 100，则将其计数并输入到此工作簿的工作表2中的单元格B10中]在检查整个wbSource之后。

应该每月重复一次。

整个概念基于带有文件浏览器功能的用户表单，用户可以在其中选择一个excel文件，并通过单击命令按钮根据avarage_calc和countif条件自动评估该文件。那就是为什么我需要它作为VBA。

任何想法，除了我现有的代码外，如何根据上述条件添加countif函数？

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结果表2
wb.Source sheet1

我试图找出如何使用以下条件条件来扩展下面的代码：如果Workbbook 1（wbSource）中的一行的列H =“ 01.January”中的值且列AD = <50，则。 ..

我想我明白了您的要求，如果我完全错过了要点，请原谅我。您应该可以将其放在现有代码的底部。一些注意事项：

• 因为我假设您不希望每个月的值都覆盖前一个月的值，所以我将1月放在B列中，将2月放在C中，依此类推。（如果要更改，则为1+x部分）。

编辑：循环1到12与m =函数配对将在您要查找的日期范围内循环。

我还更改了第二个和第三个函数的公式，以使您不会重叠（因为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

Answer 1

我想我明白了您的要求，如果我完全错过了要点，请原谅我。您应该可以将其放在现有代码的底部。一些注意事项：

• 因为我假设您不希望每个月的值都覆盖前一个月的值，所以我将1月放在B列中，将2月放在C中，依此类推。（如果要更改，则为1+x部分）。