求助！帮忙修改代码，多谢！！！具体要求详见附件。

tsingcea

zjdh 发表于 2012-8-1 10:47
Private Sub CommandButton4_Click()    '按钮粘贴
    On Error GoTo Err
    Set S = Application.Inte ...

太好啦！正是我想要的结果。真是太感谢啦！！！！！！！！！！！
另外，还有一点，最后一点，需要大师再费心一下。
就是，如附件，表格的行数可以逐行增加的（在表格最底行的下一行，只要点击就可自动生成一行），这个末尾行是动态的行，而且程序也做了自动返回最后一行的行号。
我的意思就是希望在粘贴的时候，如果内容太多而超过表格最后一行或者在表格最后一行之外进行粘贴都是无法进行的。这个代码如何写？

zjdh

Private Sub CommandButton4_Click()    '按钮粘贴
    On Error GoTo Err
    Set S = Application.Intersect(Selection, Range("G:H"))
    If Not S Is Nothing Then MsgBox "你选择的区域不得粘贴！": Exit Sub
    Set S = Application.Intersect(Selection, Range("J:L"))
    If Not S Is Nothing Then MsgBox "你选择的区域不得粘贴！": Exit Sub
    Set S = Application.Intersect(Selection, Range("N:P"))
    If Not S Is Nothing Then MsgBox "你选择的区域不得粘贴！": Exit Sub
    Set S = Application.Intersect(Selection, Range("R:T"))
    If Not S Is Nothing Then MsgBox "你选择的区域不得粘贴！": Exit Sub
    Set S = Application.Intersect(Selection, Rows(Range("C65536").End(3).Row + 1))
    If Not S Is Nothing Then MsgBox "你选择的区域超过了表格区域": Exit Sub
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats:  Exit Sub
Err:
    If Application.CutCopyMode = False Then
        MsgBox "您还没复制，或请重新复制。"
    Else
        MsgBox "如果粘贴整行或整列，请注意粘贴位置；" & Chr(10) & "另外，本命令在剪切模式下不可使用。"
    End If
End Sub

tsingcea

zjdh 发表于 2012-8-1 15:56
Private Sub CommandButton4_Click()    '按钮粘贴
    On Error GoTo Err
    Set S = Application.Inte ...

感谢您这么快就能回复俺。可是测试后发现并不能达到俺要的效果啊。
Rows(Range("C65536").End(3).Row + 1))是个什么意思？
俺的意思是如附件的话，就是第14行和第14行之后的行都不要粘贴。如果通过点击第14行而新增一行之后，就是第15行和第15行之后的行都不要粘贴。如果接着点击第15行而再次新增一行的话，就是第16行和第16行之后的行不要粘贴。以此类推。不晓得我的表达是否准确，您是否明白？
这个动态的过程，比较麻烦。

另外，之前的那个禁止粘贴某些列的代码，发现了一个不足。就是虽然单独粘贴的时候或者选择上此列的时候不能粘贴，但是一旦选择上可以粘贴的列，而这个复制过来的内容是多列的，却仍旧可以覆盖禁止粘贴的列。比如附件中，如果从别处复制一个两列的内容，而在粘贴时，从F列、I列、M列或者Q列粘贴的时候，仍旧可以粘贴到G列、J列、N列或R列。这个算是不太完美的一点。还有没有办法进一步增强呢？
大师费心了啊。

tsingcea

zjdh 发表于 2012-7-28 08:46 这可能是Excel没考虑的问题，页面操作不可改变锁定的单元格内容，VBA却可以操作。 要解决也并不不难，2种方 ...

第二种方案是我想要的，但有一个问题，就是不可粘贴列必须为选择列才行，如果粘贴多列，而偏偏不可粘贴列没有被选择，这样也可实现粘贴。请问如何在任何情况下都不能粘贴？

zjdh

Private Sub CommandButton4_Click()    '按钮粘贴
    On Error GoTo Err
    Set D = New DataObject
    D.GetFromClipboard
    X = UBound(Split(Replace(D.GetText(1), vbCrLf, vbTab), vbTab))
    If Abs(Selection.Cells.Count - X) > 0 Then  MsgBox "请选择整个粘贴区域！": Exit Sub
    Set S = Application.Intersect(Selection, Range("G:H"))
    If Not S Is Nothing Then MsgBox "你选择的区域不得粘贴！": Exit Sub
    Set S = Application.Intersect(Selection, Range("J:L"))
    If Not S Is Nothing Then MsgBox "你选择的区域不得粘贴！": Exit Sub
    Set S = Application.Intersect(Selection, Range("N:P"))
    If Not S Is Nothing Then MsgBox "你选择的区域不得粘贴！": Exit Sub
    Set S = Application.Intersect(Selection, Range("R:T"))
    If Not S Is Nothing Then MsgBox "你选择的区域不得粘贴！": Exit Sub
    Set S = Application.Intersect(Selection, Rows(UsedRange.Rows.Count + 1))
    If Not S Is Nothing Then MsgBox "你选择的区域超过了表格区域": Exit Sub
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Exit Sub
Err:
    If Application.CutCopyMode = False Then
        MsgBox "您还没复制，或请重新复制。"
    Else
        MsgBox "如果粘贴整行或整列，请注意粘贴位置；" & Chr(10) & "另外，本命令在剪切模式下不可使用。"
    End If
End Sub

tsingcea

zjdh 发表于 2012-8-4 13:39
Private Sub CommandButton4_Click()    '按钮粘贴
    On Error GoTo Err
    Set D = New DataObject

感谢您能够一而再再而三的为我提供这么大的帮助，我也有些不好意思再提出什么要求了。虽说这种办法可以避免不想粘贴的区域，但是必须得画出同复制区域数量和样式一样的单元格，如果单元格非常多，在实际操作中会非常不便，因为要准确确定粘贴区域的单元格数量和样式，还是比较麻烦。
另外，在这次中，有个提示“你选择的区域超过了表格区域”，我很有兴趣，难道不能搞个如下的提醒吗？——“你粘贴的区域超过了表格区域”。

zjdh

你自己喜欢改成啥样就改成啥样{:soso_e113:}

tsingcea

zjdh 发表于 2012-8-6 13:14
你自己喜欢改成啥样就改成啥样

晕，我倒是想改，可惜不会改啊。呜呜呜。看来真得找个机会好好学习学习了。不过，这也不是一天两天的事。╮(╯▽╰)╭，痛苦中。
对了，能否实现如下情况：
1、粘贴的时候只要选择需要粘贴的列就行，不必选择整个粘贴区域。
2、在粘贴的时候能够提示“你粘贴的区域超过了表格区域”而不是“你选择的区域超过了表格区域”
我觉得如果实现这些问题，就可以完美解决我所需要的问题了。
最后请大师真的再费费心，最有一个请求了。麻烦您啦。{:soso_e154:}

tsingcea

zjdh 发表于 2012-8-13 08:32 我是特意做成不可在模块中运行的，那是怕你其他工作表格式不一致，造成功能混乱！ 若各工作表格式一致，可 ...

哦，原来如此。我的只有部分列号有不同，应该不会影响太大吧？另外，不明白如果格式有不同，又需要在模块中使用要如何区分啊？

tsingcea

zjdh 发表于 2012-8-6 13:14
你自己喜欢改成啥样就改成啥样

大师，能否实现如下情况：
1、粘贴的时候只要选择需要粘贴的列就行，不必选择整个粘贴区域。
2、在粘贴的时候能够提示“你粘贴的区域超过了表格区域”而不是“你选择的区域超过了表格区域”
我觉得如果实现这些问题，就可以完美解决我所需要的问题了。
最后请大师真的再费费心，最有一个请求了。麻烦您啦。{:soso_e154:}
搞了几次，都是失败。还望大师再帮一次啦。