- 1、原创力文档(book118)网站文档一经付费(服务费),不意味着购买了该文档的版权,仅供个人/单位学习、研究之用,不得用于商业用途,未经授权,严禁复制、发行、汇编、翻译或者网络传播等,侵权必究。。
- 2、本站所有内容均由合作方或网友上传,本站不对文档的完整性、权威性及其观点立场正确性做任何保证或承诺!文档内容仅供研究参考,付费前请自行鉴别。如您付费,意味着您自己接受本站规则且自行承担风险,本站不退款、不进行额外附加服务;查看《如何避免下载的几个坑》。如果您已付费下载过本站文档,您可以点击 这里二次下载。
- 3、如文档侵犯商业秘密、侵犯著作权、侵犯人身权等,请点击“版权申诉”(推荐),也可以打举报电话:400-050-0827(电话支持时间:9:00-18:30)。
- 4、该文档为VIP文档,如果想要下载,成为VIP会员后,下载免费。
- 5、成为VIP后,下载本文档将扣除1次下载权益。下载后,不支持退款、换文档。如有疑问请联系我们。
- 6、成为VIP后,您将拥有八大权益,权益包括:VIP文档下载权益、阅读免打扰、文档格式转换、高级专利检索、专属身份标志、高级客服、多端互通、版权登记。
- 7、VIP文档为合作方或网友上传,每下载1次, 网站将根据用户上传文档的质量评分、类型等,对文档贡献者给予高额补贴、流量扶持。如果你也想贡献VIP文档。上传文档
查看更多
本方法要使用EXCEL VBA宏代码进行操作,代码如下:Option ExplicitSub 复制粘贴可见单元格()?Dim rgSrc As RangeDim rgDes As RangeDim rg As Range, rgPt As RangeDim strSrcAdd() As StringDim lCnt As Long, i As Long, j As Long, x As Long, y As Long
On Error GoTo ExitPoint
Set rgSrc = Application.InputBox(请选择要复制的单元格区域, 提示, , , , , , 8)If rgSrc.Columns.Count rgSrc.Parent.UsedRange.Columns.Count ThenSet rgSrc = rgSrc.Parent.Range(rgSrc.Item(1, 1), rgSrc.Item(rgSrc.Rows.Count, rgSrc.Parent.UsedRange.Columns.Count))End IfIf rgSrc.Rows.Count rgSrc.Parent.UsedRange.Rows.Count ThenSet rgSrc = rgSrc.Parent.Range(rgSrc.Item(1, 1), rgSrc.Item(rgSrc.Parent.UsedRange.Rows.Count, rgSrc.Columns.Count))End IfSet rgDes = Application.InputBox(请选择要粘贴的单元格位置, 提示, , , , , , 8)Application.ScreenUpdating = FalseApplication.Calculation = xlCalculationManualSet rgPt = rgDes.Cells(1, 1)ReDim strSrcAdd(0)For Each rg In rgSrcIf Not (rg.Height = 0 Or rg.Width = 0) ThenReDim Preserve strSrcAdd(UBound(strSrcAdd) + 1)strSrcAdd(UBound(strSrcAdd)) = rg.AddressEnd IfNext rg
lCnt = 0For Each rg In rgSrc.Parent.Range((rgSrc.Rows(1).Address))If rg.Width 0 ThenlCnt = lCnt + 1End IfNextstrSrcAdd(0) = lCnt
i = 0j = 0x = 0y = 0For lCnt = 1 To UBound(strSrcAdd)lp: If ((lCnt - 1) \ strSrcAdd(0)) + i x Thenj = 0End Ifx = ((lCnt - 1) \ strSrcAdd(0)) + iy = ((lCnt - 1) Mod strSrcAdd(0)) + jSet rg = rgPt.Offset(x, y)If rg.Width = 0 Thenj = j + 1GoTo lpElseIf rg.Height = 0 Theni = i + 1j = 0GoTo lpElserg.Value = rgSrc.Parent.Range(strSrcAdd(lCnt))End IfNext lCntrgDes.Parent.ActivateExitPoint:Application.ScreenUpdating = TrueApplication.Calculation = xlCalculationAutomaticEnd Sub下面将以一个示例的方式,演示如何使用以上代码。图中标黄色的为要隐藏的单元格,隐藏前后效果如图所示。
在相应的工作表上点击右键,在弹出的窗口中选择“查看代码”
在打开的VBE界面中粘贴以上复制的代码。
在“查看宏”对话框中选择并运行名为“复制粘贴可见单元格”的宏。宏的使用方法,请另外百度。
先选择要复制的单元(也可以是整行或整列),然后选择要粘贴的单元格位置(可以多选,也可以只选一个,都是以选择区域的活动单元为开始粘贴位置)。
粘贴完成后对比效果如下图,宏只对可见的单元格进行了操作。
文档评论(0)