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

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

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

每月应重复此操作。

整个概念基于一个带有文件浏览器功能的用户表单，用户可以选择一个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

---

我想我明白你在找什么了，如果我完全没有抓住要点，请原谅。您应该能够将其放在现有代码的底部。请注意：

• 由于我假设您不希望每个月的值覆盖前一个月的值，所以我将1月的值设置为B列，2月的值设置为C列，等等（如果您想更改它，这是

  1+x

  部分）

• 编辑：与

  m=

  函数配对的循环1到12将在您要查找的日期范围内循环

• 我还修改了第二个和第三个函数的公式，这样就不会有重叠（因为1 had=50，所以任何等于50的东西都会出现在这两个函数中）

  尺寸x与长度相同
  日期
  对于x=1到12
  m=CDate（x&“/1/2019”）
  ws.Cells（8,1+x）=_
  Application.WorksheetFunction.CountIfs（wsSource.Columns（8），m_
  wsSource.Columns（30），“”&50，wsSource.Columns（30），“”&100）
  下一个x
  

---

我想知道，如果（这个和那个），那么计算的范围是多少？或者你的意思是（1）如果H列是确定的值，则计算AD列。。。。然后（2）如果（列AD的）计数结果=<50，则将其放入Sheet2单元格B8？感谢反馈，如果列AD&H中x行的单元格满足条件，我希望代码对x行进行计数。这基本上就是我所需要的。谢谢@barvobot！这看起来很有希望，但问题是代码每个月的结果都是“0”。是不是因为月份的格式？源工作表中的月份格式如下：“01.02.2019”。还有一件事：只应考虑包含月份第一个的行。意思：01.01、01.02、01.03等等。我不确定你的代码是否涵盖了这些条件。明白了。我把答案改成了应该更有效的答案。我让

CountIfs

公式接受年份的通配符，但是如果您只是想要一个特定的年份，我会输入一个注释掉的

m=

版本来指定年份。有一个sytax错误-所有的ws.Cells行都是高位红色。你知道为什么吗？谢谢我想这和“m&*”部分有关吧？错误消息指向带有“预期表达式”的*处。

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