【求助】如何提取满足两个条件的文本（非数值），并将所有满足条件的文本用顿号连....

guaguahu

【求助】如何提取满足两个条件的文本（非数值），并将所有满足条件的文本用顿号连接填入一个单元格
求助各位老师，最好是2013能实现的

3190496160

Sub test()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("基础数据")
    r = .Cells(Rows.Count, 6).End(xlUp).Row '- 1
    .Range("m3:p" & r) = Empty
    ar = .Range("f1:p" & r)
    For i = 3 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            d(Trim(ar(i, 1))) = i
        End If
    Next i
    For j = 8 To UBound(ar, 2)
        If Trim(ar(2, j)) <> "" Then
            d(Trim(ar(2, j))) = j
        End If
    Next j
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    br = .Range("a1:d" & rs)
    For i = 2 To UBound(br)
        n = d(Trim(br(i, 3)))
        m = d(Trim(br(i, 4)))
        If n <> "" And m <> "" Then
            If ar(n, m) = "" Then
                ar(n, m) = br(i, 1)
            Else
                ar(n, m) = ar(n, m) & "、" & br(i, 1)
            End If
        End If
    Next i
    For i = 3 To UBound(ar)
        For j = 8 To UBound(ar, 2)
            .Cells(i, j + 5) = ar(i, j)
        Next j
    Next i
End With
MsgBox "ok!"
End Sub

3190496160

guaguahu

3190496160 发表于 2021-2-9 18:01
Sub test()
Dim d As Object
Set d = CreateObject("scripting.dictionary")

感谢指导。还想问一句，代码如何储存呢？

ymkghc

PQ直接刷新就行

gykg-excel

最后一列排下序
=SUBSTITUTE(SUBSTITUTE(PHONETIC(OFFSET($A1:$B1,MATCH(F2,$D$2:$D$100,),,COUNTIF($D$2:$D$100,F2))),"男","、"),"女","、")

guaguahu

ymkghc 发表于 2021-2-17 09:11
PQ直接刷新就行

可以告知一下操作步骤么，是不是得2019版本才可以实现？

shinechou86

guaguahu 发表于 2021-2-26 10:11
可以告知一下操作步骤么，是不是得2019版本才可以实现？

2016以上版本都可以