如何组合这些 vba 宏

Question

我有一个用于项目的 vba 宏。

    
   Sub Count_Rows_Specific_Data_0835()
 With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 2
End With
ActiveWindow.FreezePanes = True
   Columns("aa:aJ").ColumnWidth = 27.5
   Columns("P:az").HorizontalAlignment = xlCenter
   Columns("p:az").VerticalAlignment = xlCenter
    Dim r As Long
    Dim L As Long
    Dim N As Long
    Dim P As Long
    Dim O As Long
    Dim a As Long
    Dim F As Long
    Dim G As Long
    Dim col As Range, I As Long
    Dim E As Long
Dim q As Long
    Dim c As Long
    Dim MyRange As Range
    Dim myCell As Range
    Dim M, range_1 As Range
Dim counter As Long
Dim iRange As Range

With ActiveSheet.UsedRange

    'loop through each row from the used range
    For Each iRange In .Rows

        'check if the row contains a cell with a value
        If Application.CountA(iRange) > 0 Then

            'counts the number of rows non-empty Cells
            counter = counter + 1

        End If

    Next

End With
 
   Set range_1 = Range("J1").EntireColumn
    With range_1
    r = Worksheets("Default").Cells(Rows.Count, "A").End(xlUp).Row
    a = Worksheets("DEFAULT").UsedRange.Resize(ColumnSize:=1).SpecialCells(xlCellTypeVisible).Cells.Count
    I = counter - r

    
    For L = 2 To counter
    If Worksheets("Default").Rows(L).EntireRow.Hidden = False Then
        Select Case Worksheets("Default").Cells(L, "O")
            Case ChrW(&H2713):             N = N + 1

        End Select
    End If
Next L
For L = 2 To counter
    If Worksheets("Default").Rows(L).EntireRow.Hidden = False And Worksheets("Default").Cells(L, "o") = ChrW(&H2713) Then
        Select Case Worksheets("Default").Cells(L, "F")
            Case "Approved":            M = M + 1
            Case "In Work":            O = O + 1
                Case "Canceled": P = P + 1
            Case "In Review": q = q + 1

        End Select
    End If
Next L
    End With
    
    
    
    Worksheets("default").Cells(counter + 2, "Ab") = N
    Worksheets("Default").Cells(counter + 1, "Ab") = "MSN 0835"
    Worksheets("default").Cells(counter + 2, "aa") = "To be incorporated"
    Worksheets("default").Cells(counter + 3, "aa") = "Approved"
    Worksheets("default").Cells(counter + 4, "aa") = "In work"
    Worksheets("default").Cells(counter + 5, "aa") = "Cancelled"
    Worksheets("default").Cells(counter + 6, "aa") = "In review"
    Worksheets("default").Cells(counter + 3, "Ab") = M
    Worksheets("default").Cells(counter + 4, "Ab") = O
       Worksheets("default").Cells(counter + 5, "Ab") = P
    Worksheets("default").Cells(counter + 6, "Ab") = q
        Worksheets("Sheet1").Cells("1", "c") = N
   

    

    End Sub

基本上，这个宏将进入 excel 工作表，从该特定列中搜索刻度。如果那里有勾号，它将被放入 N 的值中。之后，这将查看另一列 F 列，以查看是否有任何已批准、正在工作、已取消（是的，我知道它的拼写错误）并在审核中，然后将添加到最后显示的另一个计数器上。

目前我遇到的问题非常轻微。我使用此宏仅在某个列中搜索刻度，目前我需要将其与其他宏组合以在其他列中搜索刻度。我目前拥有的实际上是相同的宏，重复 12 次以查找列的相同变量的值。

这是一个例子。我使用此宏在 o 列中查找刻度，这仅适用于 MSN（制造商序列号）0835。在找到 MSN 0835 的刻度数量后，它仅出现在特定的列 o 中，然后我将扫描列 f 以查看是否单元格包含工作中、已批准、已取消或正在审核中，并计算每个单元格出现的次数。我对列 P 有相同的宏，即 msn 1238。在这种情况下，我对总共 12 列有相同的宏，查找不同的 msn。有没有办法可以用来组合它们？

PS。这些宏所经历的唯一变化是它们在不同的列中填充单元格，从 aa 到 al。另一个唯一的变化是从

Worksheets("Default").Cells(counter + 1, "Ab") = "MSN 0835"

至

 Worksheets("Default").Cells(counter + 1, "Ac") = "MSN 1238"

这里是从左到右的msns：0835,1238,1250,1017,1195,1408,3504,2342,2737,2912,3749,0000

我试过做同样的事情，但在同一个宏中使用不同的值，结合 2，不起作用并且同时使我的 excel 崩溃。

Answer 1

计算特定数据的行数

新方法（程序）

Sub CountMsnsTEST()
    
    Const MsnCodesList As String _
        = "0835,1238,1250,1017,1195,1408,3504,2342,2737,2912,3749,0000"
    Const SourceColumnsList As String _
        = "O,P,Q,R,S,T,U,V,W,X,Y,Z"
    Const DestinationColumnsList As String _
        = "AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM"
    
    Dim MsnCodes() As String: MsnCodes = Split(MsnCodesList, ",")
    Dim sColumns() As String: sColumns = Split(SourceColumnsList, ",")
    Dim dColumns() As String: dColumns = Split(DestinationColumnsList, ",")
    
    Dim n As Long
    
    For n = 0 To UBound(MsnCodes)
        CountMsns MsnCodes(n), sColumns(n), dColumns(n)
    Next n

End Sub

对您的方法进行必要的修改（程序）

Sub CountMsns( _
        ByVal MsnCode As String, _
        ByVal SourceColumn As String, _
        ByVal DestinationColumn As String)
 
' code...
 
    Select Case Worksheets("Default").Cells(L, SourceColumn)
 
' code...
    
    If Worksheets("Default").Rows(L).EntireRow.Hidden = False _
            And Worksheets("Default").Cells(L, SourceColumn) = ChrW(&H2713) Then
 
' code...

    With Worksheets("Default")
        .Cells(counter + 1, DestinationColumn) = "MSN " & MsnCode
        .Cells(counter + 2, DestinationColumn) = n
        .Cells(counter + 3, DestinationColumn) = M
        .Cells(counter + 4, DestinationColumn) = O
        .Cells(counter + 5, DestinationColumn) = P
        .Cells(counter + 6, DestinationColumn) = q
    End With
 
' code...
 
End Sub