请大神帮忙解决多条件汇总的问题

逆天修炼

如果，请大神帮忙解决多条件汇总的问题，谢谢

gototom

没有明白你说的啥意思。

逆天修炼

要求如下：

autohotey

看不明白， 请集齐以下四要素：根据什么条件，该怎么计算，什么地方输出，输出什么内容。

dambcer

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, i&, j&, strSymbol$, isFlag As Boolean
   
    Application.ScreenUpdating = False
   
    With Worksheets(1)
        With .[A1].CurrentRegion
            ar = .Value
            For i = 3 To UBound(ar)
                .Cells(i, 13) = Empty
                isFlag = True
                For j = 4 To 10
                    If Len(ar(i, j)) = 0 Then strSymbol = "√" Else strSymbol = ar(i, j)
                    If strSymbol <> ar(2, j) Then
                        isFlag = False: Exit For
                    End If
                Next j
                If isFlag Then .Cells(i, 13) = ar(i, 2)
            Next i
        End With
        .Activate
    End With
   
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

usedrange

参与一下。。。。。。。。。。。。

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.12.21
   
2.     Application.ScreenUpdating = False
   
3.     With Sheets("Sheet1")
   
4.         .AutoFilterMode = False
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .[a1].Resize(r, 14)
   
7.         stt = ""
   
8.         For j = 4 To 10
   
9.             stt = stt & arr(2, j)
   
10.         Next
    
11.         For i = 3 To UBound(arr)
    
12.             st = ""
    
13.             For j = 4 To 10
    
14.                 If arr(i, j) = Empty Then arr(i, j) = "√"
    
15.                 st = st & arr(i, j)
    
16.             Next
    
17.             If st = stt Then arr(i, 13) = arr(i, 2) Else arr(i, 13) = ""
    
18.         Next i
    
19.         .[a1].Resize(r, 14) = arr
    
20.     End With
    
21.     Application.ScreenUpdating = True
    
22.     MsgBox "OK！"
    
23. End Sub
    

复制代码