如何对公司的数据进行排序并从不同的 2 张循环
How to sort companies' data and loop from different 2 sheets
我想在 VB 中制作宏 Excel:
我有两个 sheets:
- Sheet 概览 有公司的 ID 列(不重复)和他们在列中可能拥有的证书类型。
- Sheet Certificates 包含公司的 ID 列(重复)和他们在列中拥有的证书类型。
我想为每个 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)
我想在 VB 中制作宏 Excel:
我有两个 sheets:
- Sheet 概览 有公司的 ID 列(不重复)和他们在列中可能拥有的证书类型。
- Sheet Certificates 包含公司的 ID 列(重复)和他们在列中拥有的证书类型。
我想为每个 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)