关于复制粘贴的代码

excelnew1

关于复制粘贴的代码。最好用数组实现。

山菊花

供参考。

lsc900707

1. Sub gj23w98()
   
2.     Columns(20).ClearContents
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     ar = Application.InputBox("Select", "Select", , , , , , 8)
   
5.     For Each c In ar
   
6.         If c <> "" Then d(c) = ""
   
7.     Next
   
8.     n = 0
   
9.     For i = 1 To d.Count
   
10.         Cells(1 + n, 20) = Application.Small(d.keys, i)
    
11.         n = n + 1
    
12.     Next
    
13. End Sub

复制代码

lsc900707

代码在审核中，先参考附件：

excelnew1

lsc900707 发表于 2018-10-14 10:36
代码在审核中，先参考附件：

老师，当选择1个单元格时会出错。

lsc900707

excelnew1 发表于 2018-10-14 10:54
老师，当选择1个单元格时会出错。

一个单元格怎么排序？

excelnew1

lsc900707 发表于 2018-10-14 11:03
一个单元格怎么排序？

老师，不好意思。我是想如果能1个单元格也能粘贴实现，这样效果更为自由和全面。

lsc900707

excelnew1 发表于 2018-10-14 11:19
老师，不好意思。我是想如果能1个单元格也能粘贴实现，这样效果更为自由和全面。

那就修改一下：

1. Sub gj23w98()
   
2.     Columns(20).ClearContents
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     If TypeName(Selection) = "Range" Then
   
5.         If Selection.Count < 2 Then
   
6.              [t1] = Selection.Value
   
7.         Else
   
8.             arr = Selection.Value
   
9.             For Each c In arr
   
10.                 If c <> "" Then d(c) = ""
    
11.             Next
    
12.         End If
    
13.         n = 0
    
14.         For i = 1 To d.Count
    
15.             Cells(1 + n, 20) = Application.Small(d.keys, i)
    
16.             n = n + 1
    
17.         Next
    
18.     End If
    
19. End Sub

复制代码