求如图需求的公式,谢谢

简单平淡45

求如图需求的公式,谢谢

逍遥爱迪生

用VBA实现最方便了

1. Sub ExtractUniqueValues()
   
2.     Dim ws As Worksheet
   
3.     Dim sourceRange As Range
   
4.     Dim cell As Range
   
5.     Dim dict As Object
   
6.     Dim i As Long
   
7.    
   
8.     ' 设置工作表和选区
   
9.     Set ws = ThisWorkbook.ActiveSheet
   
10.     Set sourceRange = ws.Range("A1:K10")
    
11.    
    
12.     ' 创建字典对象用于存储唯一值
    
13.     Set dict = CreateObject("Scripting.Dictionary")
    
14.    
    
15.     ' 遍历选区，将非空值添加到字典中（自动去重）
    
16.     For Each cell In sourceRange
    
17.         If cell.Value <> "" Then
    
18.             dict(CStr(cell.Value)) = 1 ' 使用值作为键，确保唯一性
    
19.         End If
    
20.     Next cell
    
21.    
    
22.     ' 清空H列数据（保留标题行，从第2行开始清空）
    
23.     ws.Range("H2:H" & ws.Cells(ws.Rows.Count, "H").End(xlUp).Row).ClearContents
    
24.    
    
25.     ' 将字典中的唯一值写入H列
    
26.     i = 2 ' 从第2行开始写入（假设第1行是标题）
    
27.     For Each key In dict.Keys
    
28.         ws.Cells(i, "H").Value = key
    
29.         i = i + 1
    
30.     Next key
    
31.    
    
32.     MsgBox "已成功提取 " & dict.Count & " 个不重复的非空值到H列!", vbInformation
    
33. End Sub   

复制代码

苏小亓

升级到新版office或者WPS，一个函数就可以解决。不用复杂的公式，07版的公式比较复杂

zhaojiaoyang200

=TOCOL(TRIMRANGE(B:E),1,1)

魚。。

大概就是Indirect+text的套路，不要用07版，漏洞bug最多的一个版本，尤其VB里

mykitami

=TOCOL(B:E,1,1)

简单平淡45

魚。。 发表于 2025-5-9 10:37
大概就是Indirect+text的套路，不要用07版，漏洞bug最多的一个版本，尤其VB里

没办法啊,公司的电脑,统一07

苏小亓

1. =INDIRECT(TEXT(RIGHT(SMALL(IF($G$2:$I$5<>"",ROW($2:$5)*10+COLUMN(G:I)*10001,99999),ROW(A1)),3),"r0c0"),)&""

复制代码

wanglichun2020

复制粘贴吧，没一分钟的活
又想牛干活，又不想牛吃草！

quqiyuan

附件也不上一个呢？？！！