为 Excel 任务构建 VBA 宏

Question

对 VBA 编码非常陌生，并试图弄清楚如何编辑我录制的宏上的代码。

背景：

在我的宏中记录了一些用于过滤和排序数据的步骤

以下是录制内容的代码：

Sub Macro6()
'
' Macro6 Macro
'
' Keyboard Shortcut: Ctrl+l
'
    Range("A2:L2").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$L$18").AutoFilter Field:=1, Criteria1:="NW EMER"
    ActiveSheet.Range("$A$2:$L$18").AutoFilter Field:=7, Criteria1:="CBC7"
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("L2:L18"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

2024年1月4日至2024年10月4日的假报告
PT 位置	PT DOB	点名称	订购	冷	RESDT	休闲
西北紧急状态	1997年9月18日	史密斯，艾米丽	全血细胞计数 (CBC)	2024年4月1日12:04:00	2024年4月1日12:57:00	34
N450	1985 年 4 月 2 日	约翰逊，本杰明	基础代谢面板（BMP）	2024年4月2日1:23:00	2024年4月2日2:46:00	56
W550	1972年11月30日	布朗，索菲亚	肌钙蛋白	2024年4月3日12:12:00	2024年4月3日1:32:00	55
W550	2000年7月13日	戴维斯，亚历山大	基础代谢面板（BMP）	2024年4月4日1:48:00	2024年4月4日2:59:00	47
N450	1991 年 2 月 25 日	米勒，奥利维亚	肌钙蛋白	2024年4月5日8:16:00	2024年4月5日8:59:00	30
西北紧急状态	1983年6月8日	威尔逊，诺亚	全血细胞计数 (CBC)	2024年4月6日4:43:00	2024年4月6日5:43:00	47
N450	1968年10月21日	泰勒，艾玛	肌钙蛋白	2024年4月7日3:22:00	2024年4月7日4:14:00	33
W550	2005年3月14日	利亚姆·安德森	全血细胞计数 (CBC)	2024年4月8日6:02:00	2024年4月8日7:10:00	44
西北紧急状态	1994年8月7日	托马斯，艾娃	基础代谢面板（BMP）	2024年4月9日10:29:00	4/9/2024 11:32:00	37
西北紧急状态	1979 年 5 月 26 日	马丁内斯，雅各布	肌钙蛋白	2024年4月10日3:45:00	2024年4月10日4:25:00	18
N450	1/9/1988	杰克逊，伊莎贝拉	基础代谢面板（BMP）	2024年4月1日2:07:00	2024年4月1日3:15:00	41
W550	1960年3月12日	怀特，伊森	全血细胞计数 (CBC)	2024年4月3日11:05:00	2024年4月3日12:15:00	57
N450	1976 年 9 月 29 日	哈里斯，米娅	肌钙蛋白	2024年4月5日3:18:00	2024年4月5日4:53:00	64
西北新兴市场	1993年4月17日	克拉克，威廉	肌钙蛋白	2024年4月7日9:21:00	2024年4月7日10:45:00	48
西北紧急状态	2002年11月11日	年轻的夏洛特	基础代谢面板（BMP）	2024年4月9日1:00:00	2024年4月9日2:50:00	80
西北紧急状态	1954 年 9 月 15 日	詹姆斯·罗德里格斯	全血细胞计数 (CBC)	2024年4月2日4:41:00	2024年4月2日6:21:00	66

现在对于这段代码，我想向宏添加另一个“步骤”，然后它将分析刚刚过滤的数据，并在新的工作表上向我报告 L 列中有多少个值以及这些值等于或小于某个值。我尝试要求 AI 为我编写代码（ChatGPT 和 Claude），但无论我要求 AI 修复代码多少次，它编写的宏都无法正常运行，只是在要求我选择数据后才执行此操作:

当我尝试运行宏时会发生什么的照片

这是克劳德最后写的代码：

Sub Macro6()

    ' Filter the data
    Range("A3:L3").AutoFilter
    ActiveSheet.Range("$A$3:$L$19").AutoFilter Field:=1, Criteria1:="NW EMER"
    ActiveSheet.Range("$A$3:$L$19").AutoFilter Field:=7, Criteria1:="CBC7"

    ' Sort the filtered data
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:=Range("L3:L19"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' Count the number of values less than or equal to 45 in column L
    Dim countLessEqualTo45 As Long
    countLessEqualTo45 = 0
    Dim totalCount As Long
    totalCount = 0

    Dim lastRow As Long
    lastRow = ActiveSheet.Cells(Rows.Count, "L").End(xlUp).Row

    For i = 3 To lastRow
        If ActiveSheet.Cells(i, "L").Value <= 45 Then
            countLessEqualTo45 = countLessEqualTo45 + 1
        End If
        totalCount = totalCount + 1
    Next i

    ' Create a new sheet and record the counts
    Dim newSheet As Worksheet
    Set newSheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
    newSheet.Name = "Counts"
    newSheet.Range("A1").Value = "Count of values less than or equal to 45 in column L"
    newSheet.Range("A2").Value = countLessEqualTo45
    newSheet.Range("B1").Value = "Total count of values in column L"
    newSheet.Range("B2").Value = totalCount

End Sub

我不明白这是怎么发生的？我的代码中甚至没有任何可以改变表设计的内容？？？

我尝试仔细检查行的范围，所有内容似乎都匹配？我还想提一下，当我运行宏（按 Ctrl + L）时，我实际上并没有收到错误代码，它只是执行此操作，而不是实际执行我想要的操作。

Answer 1

• 您的分析函数依赖于 L 列。代码需要从单元格中读取值。将数据加载到数组中是一个很好的方法。

Sub Demo()
    Dim i As Long, j As Long, arrRes, iR As Long
    Dim arrData, rngData As Range
    Dim LastRow As Long, RowCnt As Long, ValCnt As Long
    Const CRI1 = "NW EMER"
    Const CRI7 = "CBC7"
    Const CRIVAL = 45
    Const COLVAL = 12 'Col L
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Set rngData = Range("A2:L" & LastRow)
    arrData = rngData.Value
    For i = LBound(arrData) + 1 To UBound(arrData)
        If arrData(i, 1) = CRI1 And arrData(i, 7) = CRI7 Then
            RowCnt = RowCnt + 1
            If arrData(i, COLVAL) <= CRIVAL Then
                ValCnt = ValCnt + 1
            End If
        End If
    Next i
    Sheets.Add
    Range("A1:B1").Value = Array("Count of Rows", "Count of Values")
    Range("A2:B2").Value = Array(RowCnt, ValCnt)
End Sub