如何对公司的数据进行排序并从不同的 2 张循环

How to sort companies' data and loop from different 2 sheets

我想在 VB 中制作宏 Excel:
我有两个 sheets:

我想为每个 ID 创建计数器,他们拥有多少个特定证书类型的证书,并获取该值并打印在证书列的概述 sheet 中,最初我是这样编写代码的,但不能继续,你能告诉我如何循环某个公司 ID 并检查要计算的证书名称吗?

输出如下:

这是我的代码:

    Sub Macro7()
'
' Macro7 Macro
'

'
    ActiveCell.Offset(-2, -3).Range("A1:B1954").Select
    ActiveWorkbook.Worksheets("certificates").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("certificates").Sort.SortFields.Add2 Key:= _
        ActiveCell.Range("A1:A1954"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("certificates").Sort
        .SetRange ActiveCell.Range("A1:B1954")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Sub Test2()

      Dim companyID As String
      Dim companyID2 As String
      
      ' Select cell A2, *first line of data*.
      Range("A2").Select
      ' Set Do loop to stop when two consecutive empty cells are reached.
     Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))
        ' Insert your code here.
        'Get cell value.
        companyID = ThisWorkbook.Sheets(overview).Range("A3").Value
        companyID2 = ThisWorkbook.Sheets(certificates).Range("A3").Value
        While companyID = companyID2
        If ActiveCell.Value = companyID Then
        
        
       ' Step down 2 rows from present location.
       ActiveCell.Offset(2, 0).Select
     Loop
   End Sub
Sub loopRows()
'
' loopRows Macro
'

'
    ActiveCell.Offset(-2, -2).Range("A1").Select
End Sub

请在您这边测试。这与我的评论的公式相同,但在 VBA 中是自动化的。您将其复制粘贴到您的工作簿中。

Sub FillFormula()
Dim shOverview As Worksheet, shCert As Worksheet
Dim lastRow As Long

Set shOverview = ThisWorkbook.Sheets("Overview")
Set shCert = ThisWorkbook.Sheets("Certificates")

lastRow = shOverview.Cells(shOverview.Rows.Count, "A").End(xlUp).Row

' Fill formula from row 2 down to the last row
shOverview.Range("B2:B" & lastRow).Formula = "=IF(COUNTIFS(Certificates!A:A,Overview!A2,Certificates!B:B," & _
        DQWrap("business") & ")>0,COUNTIFS(Certificates!A:A,Overview!A2,Certificates!B:B," & _
        DQWrap("business") & ")," & DQ & ")"

shOverview.Range("C2:C" & lastRow).Formula = "=IF(COUNTIFS(Certificates!A:A,Overview!A2,Certificates!B:B," & _
        DQWrap("technology") & ")>0,COUNTIFS(Certificates!A:A,Overview!A2,Certificates!B:B," & _
        DQWrap("technology") & ")," & DQ & ")"

shOverview.Range("D2:D" & lastRow).Formula = "=IF(COUNTIFS(Certificates!A:A,Overview!A2,Certificates!B:B," & _
        DQWrap("PMP") & ")>0,COUNTIFS(Certificates!A:A,Overview!A2,Certificates!B:B," & _
        DQWrap("PMP") & ")," & DQ & ")"

shOverview.Range("E2:E" & lastRow).Formula = "=IF(COUNTIFS(Certificates!A:A,Overview!A2,Certificates!B:B," & _
        DQWrap("Art") & ")>0,COUNTIFS(Certificates!A:A,Overview!A2,Certificates!B:B," & _
        DQWrap("Art") & ")," & DQ & ")"

End Sub

' Utility function for wrapping double quotes
Function DQWrap(txt As String) As String
DQWrap = Chr(34) & txt & Chr(34)
End Function

' Utility function for adding double quotes
Function DQ() As String
DQ = Chr(34) & Chr(34)