问查找单元格在另一个工作表和count/sum实例中是否匹配
EN

Stack Overflow用户

提问于 2014-07-11 19:43:10

回答 1查看 2.1K关注 0票数 0

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

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

如果Sheet1中的活动单元格与Sheet2中的列(或范围)中的任何单元格匹配，

如果Sheet2中相邻列的同一行中的单元格不为空，

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

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

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

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

上面的公式是获取Sheet1中的单元格A8，并检查它是否与Sheet2 column A中的任何单元格匹配，

并确保Sheet2中的C列在同一行中不为空。

如果为真，则为所有实例添加1

并将该值放在Sheet1中。

我认为最好的方法是使用For Next循环，但根据我找到的示例，它无法执行任何成功的代码。

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

vba

excel

平台电商解决方案

为客户提供电商客服、电商图片系统识别及搜索的快速搭建方案

回答 1

Stack Overflow用户

发布于 2014-07-12 05:50:34

这被设置为对您在工作表1的列A中选择的所有单元格运行。

它在Sheet2列A中查找Sheet1列A上的值，然后在Sheet1列B中，显示该值在Sheet2列A中出现的次数以及列C的同一行中的值。如果答案有用，请这样标记。:-)

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