Vba 查找其他工作表和计数/求和实例中的单元格是否匹配

我一直在使用简单的excel数组公式计算主控表上的某些值，但现在我的文档中有太多公式，excel崩溃了

因此，我想创建一个可以执行相同任务的宏。我希望代码执行以下操作：

如果Sheet1中的activecell与Sheet2中列（或范围）中的任何单元格匹配

如果表2中相邻列的同一行中的单元格不是空的

然后统计特定字符串出现在Sheet2列A中的所有实例

并将值2列放置在Sheet1中原始活动单元格的右侧

以下是我使用的原始数组公式：

=SUM(IF(Sheet1!$A8=Sheet2!$A:$A,IF(SalesF_SignUp_data!$C:$C>1,1,0)))

上面的公式取表1中的单元格A8，并检查它是否与表2 A列中的任何单元格匹配

并确保表2中的C列在同一行中不是空白的

如果这是真的，则为所有实例“添加1”

并将该值放入表1中

我相信最好的方法是fornext循环，但根据我找到的示例，还没有能够执行任何成功的代码

---

如果需要，我很乐意进一步解释。由于我没有10的声誉，我无法附加图像，但如果需要，我愿意发送。

这是为您在第1页a列中选择的所有单元格设置的。
它在Sheet2列A中查找Sheet1列A上的值，然后在Sheet1列B中显示该值在Sheet2列A中出现的次数以及在列C的同一行中出现的值。 如果答案有帮助，请将其标记为：：-）

选项显式
子实例（）
Dim结果、计数器、循环计数、tocomplete、作为整数完成
Dim findtext作为变体
Dim单元、foundcell、nextcell作为范围
'检查以确保sub不会在无效范围内意外运行
如果ActiveSheet.Name“Sheet1”或ActiveCell.Column 1或Selection.Columns.Count>1，则
MsgBox（“请在第1页的a列中选择一个范围。”）
出口接头
如果结束
'如果选择整个列A，请减少其上运行的空白单元格数。
tocomplete=Application.WorksheetFunction.CountA（选择）
已完成=0
'对于选定范围内的每个单元格，在Sheet2的A列中搜索选定单元格中的值
对于选择中的每个单元格
如果已完成=完成，则退出Sub
如果单元格.Value为“”，则已完成=已完成+1
findtext=cell.Value
结果=0
Set foundcell=板材（“板材2”）。范围（“A1”）
'使用count函数确定要搜索和检查的目标值实例数
loopcount=Application.WorksheetFunction.CountIf（工作表（“Sheet2”）.Range（“A:A”）、findtext）
'如果列A中不存在目标值，则跳过循环
如果loopcount=0，则转到NotFound
'每次找到目标值时，检查C列中的单元格。如果不是空的，则递增“结果”
对于计数器=1的循环计数
设置nextcell=Sheets（“Sheet2”）.Range（“A:A”）.Find（what:=findtext，lookat:=xlother，after:=foundcell）
如果nextcell.Offset（0,2）.Value为“”，则
结果=结果+1
如果结束
设置foundcell=nextcell
下一个
'将结果放入表1的B列中
未找到：
单元格偏移量（0，1）。值=结果
空白：
下一个
端接头

Option Explicit

Sub countinstances()
Dim result, counter, loopcount, tocomplete, completed As Integer
Dim findtext As Variant
Dim cell, foundcell, nextcell As Range

'Checks to make sure the sub isn't accidentally run on an invalid range
If ActiveSheet.Name <> "Sheet1" Or ActiveCell.Column <> 1 Or Selection.Columns.Count > 1 Then
    MsgBox ("Please select a range in column A of Sheet 1.")
    Exit Sub
End If

'In case of selecting the entire column A, curtail the number of blank cells it runs on.
tocomplete = Application.WorksheetFunction.CountA(Selection)
completed = 0

'For each cell in the selected range, searches Sheet2, Column A for the value in the selected cell
For Each cell In Selection
    If completed = tocomplete Then Exit Sub
    If cell.Value <> "" Then completed = completed + 1
    findtext = cell.Value
    result = 0
    Set foundcell = Sheets("Sheet2").Range("A1")

'Uses the count function to determine how many instances of the target value to search for and check
    loopcount = Application.WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), findtext)

'Skips the loop if the target value doesn't exist in column A
    If loopcount = 0 Then GoTo NotFound

'For each time the target value was found, check the cell in column C. If it's not blank, increment "result"
    For counter = 1 To loopcount
        Set nextcell = Sheets("Sheet2").Range("A:A").Find(what:=findtext, lookat:=xlWhole, after:=foundcell)
        If nextcell.Offset(0, 2).Value <> "" Then
            result = result + 1
        End If
        Set foundcell = nextcell
    Next

'Put the result in column B of Sheet1
NotFound:
    cell.Offset(0, 1).Value = result
Blanks:
Next
End Sub