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

编程问答 2022-07-28

问题描述

我想在Excel中用VB制作宏：
我有两张纸：

  • 表格概览包含公司的 ID 列（未重复）以及它们在列中可能拥有的证书类型。
  • 表格证书包含公司的 ID 列（重复）以及他们在列中拥有的证书类型。

我想为每个 id 创建计数器，他们有多少个特定证书类型的证书，并取该值并打印在证书列的概览表中，最初我这样做了我的代码，无法继续，你能告诉我吗如何循环某些公司 id 并检查要计算的证书名称？

enter image description here

enter image description here

和这样的输出：

enter image description here

这是我的代码：

    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," & _
        DQWrap("business") & ")," & DQ & ")"

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

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

shOverview.Range("E2:E" & lastRow).Formula = "=IF(COUNTIFS(Certificates!A:A," & _
        DQWrap("Art") & ")>0," & _
        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)
excelexcelexcel-2010vba