多列转一列 升序排列去重复

ba3259878266

一把小刀闯天下 发表于 2018-9-2 14:52
Option Explicit

Sub test()

师傅 非常感谢你 很好用

microyip

用SQL的Union之后Group By一下就可以了

ba3259878266

microyip 发表于 2018-9-3 07:52
用SQL的Union之后Group By一下就可以了

好的 谢谢 明白了 师傅

microyip

1. Sub 转换()
   
2.     Dim oConn As Object
   
3.     Dim sSelect As String
   
4.     Dim vCol As Variant, nCol As Integer
   
5.    
   
6.     vCol = "1,3,5" '需要转换的列数
   
7.     vCol = Split(vCol, ",")
   
8.    
   
9.     Set oConn = CreateObject("Adodb.Connection")
   
10.     If Val(Application.Version) < 12 Then
    
11.         oConn.Open "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties='Excel 8.0;IMEX=1;HDR=No';Data Source=" & ThisWorkbook.FullName
    
12.     Else
    
13.         oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;IMEX=1;HDR=No';Data Source=" & ThisWorkbook.FullName
    
14.     End If
    
15.     For nCol = LBound(vCol) To UBound(vCol)
    
16.         If Val(vCol(nCol)) > 0 Then
    
17.             If sSelect <> "" Then sSelect = sSelect & " Union "
    
18.             sSelect = sSelect & "Select Trim([F" & vCol(nCol) & "]) As Data From [Sheet1$] Where Not [F" & vCol(nCol) & "] Is Null"
    
19.         End If
    
20.     Next
    
21.     sSelect = "Select [Data] From (" & sSelect & ") Group By [Data] Order By [Data]"
    
22.     [G:G].ClearContents
    
23.     [G1].CopyFromRecordset oConn.Execute(sSelect)
    
24.     oConn.Close
    
25.     Set oConn = Nothing
    
26. End Sub

复制代码

microyip

附上附件以供参考

ba3259878266

microyip 发表于 2018-9-3 08:24
附上附件以供参考

好的 师傅 谢谢你