VBA RemoveDuplicates Columns:=去重列能不能用变量表示

cjq001

If x1 > QSHH Then
     px2 = Worksheets("XXB").Range("ZB1").End(xlToLeft).Column
     ReDim QCLarr(1 To TQLLS)
    For i = 1 To TQLLS
       Workbooks(XMJC & WZGLTZ).Worksheets(TZMC).Range(Cells(QSHH + 1, TQLarr(i - 1)), Cells(x1, TQLarr(i - 1))).Copy                          '数值粘贴
       Workbooks(XMJC & WZGLTZ).Worksheets("XXB").Cells(1, px2).PasteSpecial Paste:=xlPasteValues
       px2 = px2 + 1
       QCLarr(i) = i
    Next

    '去重
    Worksheets("XXB").Activate
      ActiveSheet.Range(Cells(1, 1), Cells(x1, TQLLS)).RemoveDuplicates Columns:=Evaluate(QCLarr), Header:=xlNo   '去重复值
    End If
提取了几列，去重列就是几列，比如TQLLS=2时，QCLarr=array（1,2）,比如TQLLS=3时，QCLarr=array（1,2,3），但是现在编的只能对第一列去重，怎样才能用变量表示array(1,2,3)?

张雄友

去重复？07以上版本才有的。

1. Sub 每列分别删除重复项()' 选中哪些列就删除哪些列。
   
2. 
   
3.     Application.ScreenUpdating = False
   
4.     For i = Selection.Column To Selection.Columns.Count + Selection.Column - 1 '列数共多少列
   
5.     t = Timer
   
6.         ActiveSheet.Columns(i).RemoveDuplicates Columns:=1, Header:=xlYes 'Header:=xlYes表示有标题。
   
7.     Next
   
8.     Application.ScreenUpdating = True
   
9.     MsgBox Format(Timer - t, "0.00秒")
   
10. End Sub
    

复制代码

cjq001

张雄友 发表于 2014-8-19 20:43
去重复？07以上版本才有的。

这个不行吧，我想三列一块去重

cjq001

cjq001 发表于 2014-8-19 20:47
这个不行吧，我想三列一块去重

你这个只能对单列去重，我想要三列一块选
a，b，c
a，b，d
a。b，c
我想要的结果
a,b,c
a,b,d
你的只能得到
a，b，c
  ，  ，d

张雄友

cjq001 发表于 2014-8-19 20:55
你这个只能对单列去重，我想要三列一块选
a，b，c
a，b，d

这个用SQL 快。

cjq001

张雄友 发表于 2014-8-19 20:57
这个用SQL 快。

不会啊。。。。

张雄友

cjq001 发表于 2014-8-19 21:05
不会啊。。。。

换个思路，用提取的办法，附件是个例子。

1. Sub SQL通用查询()
   
2.     Dim Conn As Object, Rst As Object
   
3.     Dim strConn As String, strSQL As String
   
4.     Dim i As Integer, PathStr As String
   
5.     Set Conn = CreateObject("ADODB.Connection")
   
6.     Set Rst = CreateObject("ADODB.Recordset")
   
7.     PathStr = ThisWorkbook.FullName   '设置工作簿的完整路径和名称
   
8.     Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接
   
9.     Case Is <= 11
   
10.         strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    
11.     Case Is >= 12
    
12.         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
13.     End Select
    
14.     '设置SQL查询语句
    
15.     Conn.Open strConn    '打开数据库链接
    
16.     strSQL = "Select distinct * From [明细$A:C] where 车间 is not null " '写入SQL语句
    
17.     Set Rst = Conn.Execute(strSQL)    '执行查询，并将结果输出到记录集对象
    
18.     With Sheet2
    
19.         .Cells.Clear
    
20.         For i = 0 To Rst.Fields.Count - 1    '填写标题
    
21.             .Cells(1, i + 1) = Rst.Fields(i).Name
    
22.         Next i
    
23.         .Range("A2").CopyFromRecordset Rst
    
24.         .Cells.EntireColumn.AutoFit  '自动调整列宽
    
25.         .Cells.EntireColumn.AutoFit  '自动调整列宽
    
26.     End With
    
27.     Rst.Close    '关闭数据库连接
    
28.     Conn.Close
    
29.     Sheet2.Select
    
30.     Set Conn = Nothing
    
31.     Set Rst = Nothing
    
32. End Sub
    

复制代码

山风

副本Xl0000097.zip (11.81 KB, 下载次数: 65)

2014-8-20 10:52 上传

点击文件名下载附件

Sub 字典()
With Sheets("明细")
r = .Range("A65536").End(xlUp).Row
    Set w = CreateObject("scripting.dictionary")
    For i = 2 To r
        a = .Cells(i, 1)
        b = .Cells(i, 2)
        c = .Cells(i, 3)
        w(Join(Array(a, b, c), "/")) = 1
      Next
End With
Application.DisplayAlerts = False
[A2].Resize(w.Count, 1) = Application.Transpose(w.keys)
[A2].Resize(w.Count, 1).TextToColumns , Other:=True, OtherChar:="/"   '分列
End Sub
  

cjq001

山风 发表于 2014-8-20 10:53
Sub 字典()
With Sheets("明细")
r = .Range("A65536").End(xlUp).Row

我们的数据库r可能有几万行，这样运算的话会不会很慢呢

山风

不知道慢不慢，试试才知道