请教老师：如何找出甲乙丙组合的种类

zainan0810

请教老师：如何把甲、乙、丙下面同行的符号按现有位置的分布，组合在一起，算作一组，去掉重复组，放在从K1开始的下面。
比如：在左面的数据中，甲乙丙符号的种类，从上到下分别有：---；○--；--√；-○√；--○；○-○等等。

特殊说明：左边黄色，上行组合后为-√○○。下行组合后为-√○○。但它俩不是重复组。见k8:m9的就清楚了。 甲乙丙组合的种类.rar (23.64 KB, 下载次数: 5)

2018-6-24 22:02 上传

点击文件名下载附件

liulang0808

1、楼主可以将def三列使用公式生成辅助列，然后高级筛选去重
2、可以考虑字典去重处理的

duquancai

Sub main()
    Dim conn As Object, rst As Object, sql$
    Set conn = CreateObject("adodb.connection")
    Set rst = CreateObject("ADODB.recordset")
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
    sql = "select first(甲),first(乙),first(丙) from [Sheet1$d:f] where 甲&'|'&乙&'|'&丙<>'' group by 甲&'|'&乙&'|'&丙"
    Set rst = conn.Execute(sql)
'    Range("K:M").ClearContents
    [k1:m1] = [{"甲","乙","丙"}]
    Range("k2").CopyFromRecordset rst
End Sub

hhjjpp

何必麻烦vba

hhjjpp

瓶盖回收-h.rar (27.91 KB, 下载次数: 1)

2018-6-25 14:00 上传

点击文件名下载附件

lsdongjh

1. Sub myCount()
   
2.     Dim lngRows As Long
   
3.     Dim Conn As Object, Rst As Object, strPath As String
   
4.     Dim strConn As String, strSQL As String
   
5.     Dim rg As Range
   
6.     '清空结果区域
   
7.     lngRows = Sheet1.Range("K" & Rows.Count).End(xlUp).Row
   
8.     Sheet1.Range("K2:M" & lngRows).ClearContents
   
9. 
   
10.     lngRows = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    
11.     Set rg = Sheet1.Range("K2")
    
12. 
    
13.     Set Conn = CreateObject("ADODB.Connection")
    
14.     Set Rst = CreateObject("ADODB.Recordset")
    
15.     strPath = ThisWorkbook.FullName '设置工作簿的完整路径和名称
    
16.     Select Case Application.Version * 1 '设置连接字符串,根据版本创建连接
    
17.         Case Is <= 11
    
18.             strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & strPath
    
19.         Case Is >= 12
    
20.             strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
21.     End Select
    
22. 
    
23.     Conn.Open strConn '打开数据库链接
    
24. 
    
25.     '''''''''''''''''''''''''''''''''
    
26.     strSQL = "SELECT 甲,乙,丙 " & _
    
27.               "FROM [Sheet1$A1:I" & lngRows & "] " & _
    
28.               "Group By  甲,乙,丙"
    
29. 
    
30.     Rst.Open strSQL, Conn, 3, 1 '执行查询，并将结果输出到记录集对象
    
31. 
    
32.     rg.CopyFromRecordset Rst
    
33. 
    
34.     Set Rst = Nothing
    
35.     Set Conn = Nothing
    
36. End Sub
    

复制代码

zainan0810

liulang0808 发表于 2018-6-24 22:11
1、楼主可以将def三列使用公式生成辅助列，然后高级筛选去重
2、可以考虑字典去重处理的

谢谢liulang0808版主的指点！没想到这个时间了，您还坚守岗位呢。您的第一条，能请版主帮做下吗？因为这条思路特别新颖，我不会，想学学。

liulang0808

将高级筛选结果，拷贝到新表内，然后分列即可

zainan0810

duquancai 发表于 2018-6-25 00:11
Sub main()
    Dim conn As Object, rst As Object, sql$
    Set conn = CreateObject("adodb.connecti ...

谢谢duquancai老师的指教！您的头像我印象非常深刻，看到它，立刻认出您没少帮我忙啊。大半夜的，让您费心了！

zainan0810

hhjjpp 发表于 2018-6-25 12:28
何必麻烦vba

谢谢hhjjpp老师的指点！您也没少帮我，因为您的名字好记，呵呵。好几千行数据，我也不知哪种是最优了。