【问题标题】:How to sort companies' data and loop from different 2 sheets如何从不同的 2 张表中对公司的数据和循环进行排序
【发布时间】:2021-07-28 07:41:33
【问题描述】:

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

  • Overview 表中有公司的 ids 列(不重复)和他们可能拥有的证书类型。
  • Certificates 表有公司的 ids 列(重复)和他们在列中拥有的证书类型。

我想为每个人创建一个计数器 id 有多少特定证书类型的证书,并获取该值并打印在证书列的概览表中最初我这样做了我的代码并且无法继续,你能告诉我吗如何循环某些公司 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

【问题讨论】:

  • 也许你可以先在B2上试试这个公式,然后把公式往下拉。 =IF(COUNTIFS(Sheet1!A:A,A2,Sheet1!B:B,"business")>0,COUNTIFS(Sheet1!A:A,A2,Sheet1!B:B,"business"),"")适当调整 C2、D2 和 E2 上的工作表名称和文本
  • 更恰当命名的工作表:B2: =IF(COUNTIFS(Certificates!A:A,Overview!A2,Certificates!B:B,"business")>0,COUNTIFS(Certificates!A:A ,Overview!A2,Certificates!B:B,"business"),"")
  • 您可以使用数据透视表轻松完成此操作

标签: excel vba excel-2010


【解决方案1】:

请自行测试。这与我的 cmets 公式相同,但在 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)

【讨论】:

    猜你喜欢
    • 2017-09-27
    • 1970-01-01
    • 1970-01-01
    • 2020-12-01
    • 1970-01-01
    • 2011-09-30
    • 1970-01-01
    • 1970-01-01
    • 2021-12-10
    相关资源
    最近更新 更多