请问COPY当前选中单元格所在行的宏怎么写呢？

o0star0o

比如点击E1单元格，我按下快捷键，就复制当前选中单元格所在行E:Q的数据，但复制需要用文本的方式，下面的代码是之前朋友帮我写的，COPY出来是文本

1. Public Sub 文本剪贴板()
   
2. '在alt+F8宏设置ctrl+e做为快捷键,选中区域时,按下ctrl+e即完成文本复制
   
3. '结果以行列式文本存入剪贴板,列之间用空格分隔
   
4. '或打开本工作表 在其他表中使用ctrl+e 也可以达到文本复制的效果
   
5.     Dim tt, a, i&, j&
   
6.     On Error Resume Next
   
7.     a = Selection.Value
   
8.     For i = 1 To UBound(a)
   
9.         For j = 1 To UBound(a, 2)
   
10.             tt = tt & " " & a(i, j) '列之间用空格分隔
    
11.         Next
    
12.         tt = tt & vbNewLine '换行
    
13.     Next
    
14.     With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") '数据放入剪贴板
    
15.             .SetText tt
    
16.             .PutInClipboard
    
17.    End With
    
18. End Sub

复制代码

vbee

1.     Dim tt, a, i&, j&
   
2.     On Error Resume Next
   
3. 
   
4.     i = ActiveCell.Row
   
5.         For j = 5 To 17
   
6.             tt = tt & " " & Cells(i, j) '列之间用空格分隔
   
7.         Next
   
8.         tt = tt & vbNewLine '换行
   
9. 
   
10.     With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") '数据放入剪贴板
    
11.             .SetText tt
    
12.             .PutInClipboard
    
13.    End With

复制代码

o0star0o

vbee 发表于 2018-6-15 08:21

高手啊哥们，完美实现！
但有个问题，这个就不能复制当前行17列后其他内容了，能否加个限制条件：仅在鼠标选中E:Q（5：17）列区域时执行你这个代码，如果选中后面其他位置，还是执行之前的剪贴板代码？

jiminyanyan

o0star0o 发表于 2018-6-24 15:06
高手啊哥们，完美实现！
但有个问题，这个就不能复制当前行17列后其他内容了，能否加个限制条件：仅在鼠 ...

Sub jimin()
Dim tt, a, i&, j&
    On Error Resume Next
    k = ActiveCell.Column
    If k < 5 Or k > 17 Then
        Exit Sub
    End If
    i = ActiveCell.Row
        For j = 5 To 17
            tt = tt & " " & Cells(i, j) '列之间用空格分隔
        Next
        tt = tt & vbNewLine '换行

    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") '数据放入剪贴板
            .SetText tt
            .PutInClipboard
   End With

End Sub

个人感觉这种做法，坏处多于好处。。。。

o0star0o

jiminyanyan 发表于 2018-6-24 15:43
Sub jimin()
Dim tt, a, i&, j&
    On Error Resume Next

哥们你这个是5-17行呢？我是横排选中的这一个行的5-17列

o0star0o

jiminyanyan 发表于 2018-6-24 15:43
Sub jimin()
Dim tt, a, i&, j&
    On Error Resume Next

等你回复哥们

o0star0o

vbee 发表于 2018-6-15 08:21

哥们，一直在等您回复

有个问题，这个就不能复制当前行17列后其他内容了，能否加个限制条件：仅在鼠标选中E:Q（5：17）列区域时执行你这个代码