原来好好的，今天运行代码，结果是□□，请老师指导谢谢

hcy1185

Sub 单元格内容到剪贴板()
Dim rg As Range, k&, arr() As Variant
Dim dic As Object, i&, brr() As Variant
Dim Mydata As DataObject, s$

Set rg = Selection '选择单元格区域的顺序影响内容排列
Set dic = CreateObject("scripting.dictionary")
For Each rg In Selection
    If rg.Value <> "" And rg.Row = rg.Row Then
        k = k + 1
        ReDim Preserve arr(1 To 2, 1 To k) '二维数组前面是列，后面是行
        rg = Trim(rg)
        arr(1, k) = rg.Row
        arr(2, k) = rg.Value
    End If
Next rg

For i = 1 To UBound(arr, 2)
    dic(arr(1, i)) = dic(arr(1, i)) & IIf(dic(arr(1, i)) = "", "", "，") & arr(2, i)
Next
brr = dic.Items
For i = 0 To dic.Count - 1
    s = s & IIf(s = "", "", "；") & brr(i)
Next
s = s & "。"

Set Mydata = New DataObject
Mydata.SetText s
Mydata.PutInClipboard
End Sub

huang1314wei

1. Sub 单元格内容到剪贴板()
   
2. Dim rg As Range, k&, arr() As Variant
   
3. Dim dic As Object, i&, brr() As Variant
   
4. Dim Mydata As DataObject, s$
   
5. 
   
6. Set rg = Selection
   
7. Set dic = CreateObject("scripting.dictionary")
   
8. For Each rg In Selection
   
9.     If rg.Value <> "" And rg.Row = rg.Row Then
   
10.         k = k + 1
    
11.         ReDim Preserve arr(1 To 2, 1 To k)
    
12.         rg = Trim(rg)
    
13.         arr(1, k) = rg.Row
    
14.         arr(2, k) = rg.Value
    
15.     End If
    
16. Next rg
    
17. 
    
18. For i = 1 To UBound(arr, 2)
    
19.     dic(arr(1, i)) = dic(arr(1, i)) & IIf(dic(arr(1, i)) = "", "", "，") & arr(2, i)
    
20. Next
    
21. brr = dic.Items
    
22. For i = 0 To dic.Count - 1
    
23.     s = s & IIf(s = "", "", "；") & brr(i)
    
24. Next
    
25. s = s & "。"
    
26. CopyToClipboard (s)
    
27. End Sub
    
28. 
    
29. Sub CopyToClipboard(ByVal xStr As String)
    
30.     With CreateObject("Forms.TextBox.1")
    
31.         .Text = xStr
    
32.         .SelStart = 0
    
33.         .SelLength = Len(xStr)
    
34.         .Copy
    
35.     End With
    
36. End Sub
    

复制代码

hcy1185

huang1314wei 发表于 2020-2-26 09:05

谢谢版主！！！为什么原来可以呢？

huang1314wei

hcy1185 发表于 2020-2-26 09:18
谢谢版主！！！为什么原来可以呢？

原因不好说，个人觉得应该跟你电脑的输入法或者区域设置有关系，比如如果你是英文输入状态，你把汉字复制到剪切板，再粘贴出来可能会产生两个框框，反之则不会