怎么提取B3列至H列中姓名，如果重复，只提取一次。

1042271867 · 发表于 2024-10-24 12:37

请教：提取B3列至H列中姓名，如果重复，只提取一次。谢谢各位老师

liulang0808 · 发表于 2024-10-24 13:25

https://club.excelhome.net/threa ... tml?_dsign=b73ad3d6
字典的案例，楼主可以参考
目前可以考虑拆分，然后用字典去重

1042271867 · 发表于 2024-10-24 13:29

谢谢版主，我去看下

松永 · 发表于 2024-10-24 13:36

动态的，再加行也可以用

xlj310 · 发表于 2024-10-24 13:41

拆分与合并、再加上转置与去重函数就搞定了。
=TEXTJOIN("、",TRUE,UNIQUE(TRANSPOSE(TEXTSPLIT(TEXTJOIN("、",TRUE,B3:H3),"、"))))

everbest2015 · 发表于 2024-10-24 13:47

Sub Main()
Dim d As Object
Dim sh As Worksheet
Dim arr As Variant
Dim trr As Variant
Dim t As Variant
Dim i As Integer, j As Integer
Set sh = ThisWorkbook.Sheets(1)
Set d = CreateObject("scripting.dictionary")
With sh
      .AutoFilterMode = False
      .Range("I3:I" & .Rows.Count).ClearContents
      arr = .Range("a1").CurrentRegion
      For i = 3 To UBound(arr)
         For j = 2 To UBound(arr, 2) - 1
            trr = Split(arr(i, j), "、")
            If IsArray(trr) Then
                  For Each t In trr
                     If t <> "" Then
                        d(t) = ""
                     End If
                  Next
                  arr(i, UBound(arr, 2)) = Join(d.keys, "、")
            End If
            d.RemoveAll
         Next
      Next
      .Range("a1").CurrentRegion = arr
End With
End Sub

Qs18 · 发表于 2024-10-24 13:51

Sub qs()
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
With Sheet1
arr = .Range("a1").CurrentRegion.Value
For i = 3 To UBound(arr)
s = ""
For j = 2 To 8
s = s & "、" & arr(i, j)
Next
sr = Split(s, "、")
dic.RemoveAll
For Each rr In sr
If Len(rr) > 0 Then
dic(rr) = dic(rr)
End If
Next rr
arr(i, 9) = VBA.Join(dic.keys, "、")
Next
.Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
End With
Set dic = Nothing
End Sub

复制代码

Qs18 · 发表于 2024-10-24 13:52

试试.......

Qs18 · 发表于 2024-10-24 13:53

试试...........

Qs18 · 发表于 2024-10-24 13:54

试试............

		自动登录	找回密码
密码			免费注册

[求助] 怎么提取B3列至H列中姓名，如果重复，只提取一次。

评分

评分

评分

评分