Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 3820|回复: 10

[已解决]代码求修改

[复制链接]
发表于 2014-1-7 17:07 | 显示全部楼层 |阅读模式
    Sheets("数据连接").Range("BG5:BN14").Copy
    Sheets("送货单").Range("AN11").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone '数据(数值)黏贴
    Sheets("数据连接").Range("BG18:BN27").Copy
    Sheets("送货单").Range("AN24").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone  '数据(数值)黏贴
    Sheets("数据连接").Range("BG31:BN40").Copy
    Sheets("送货单").Range("AN37").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone  '数据(数值)黏贴
    Sheets("数据连接").Range("BG44:BN53").Copy
    Sheets("送货单").Range("AN50").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone  '数据(数值)黏贴
    Sheets("数据连接").Range("BG57:BN66").Copy
    Sheets("送货单").Range("AN63").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone  '数据(数值)黏贴
    Sheets("数据连接").Range("BG70:BN79").Copy
    Sheets("送货单").Range("AN76").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone  '数据(数值)黏贴
    Sheets("数据连接").Range("BG83:BN92").Copy
    Sheets("送货单").Range("AN89").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone  '数据(数值)黏贴
    Sheets("数据连接").Range("BG96:BN105").Copy
    Sheets("送货单").Range("AN102").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone  '数据(数值)黏贴
    Sheets("数据连接").Range("BG109:BN118").Copy
    Sheets("送货单").Range("AN115").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone  '数据(数值)黏贴
    Sheets("数据连接").Range("BG122:BN131").Copy
    Sheets("送货单").Range("AN128").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone  '数据(数值)黏贴

最佳答案
2014-1-7 19:39
  1.     Dim shtSj As Worksheet
  2.     Dim shtShd As Worksheet
  3.     Set shtSj = Worksheets("数据连接")
  4.     Set shtShd = Worksheets("送货单")
  5.     Dim i As Byte
  6.     Dim iRow1%
  7.     Application.ScreenUpdating = False
  8.     For i = 0 To 9
  9.         iRow1 = i * 13
  10.         shtSj.Range("bg" & 5 + iRow1 & ":bn" & 14 + iRow1).Copy
  11.         shtShd.Range("an" & 11 + iRow1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
  12.         'Debug.Print shtSj.Range("bg" & 5 + iRow1 & ":bn" & 14 + iRow1).Address, shtShd.Range("an" & 11 + iRow1).Address
  13.     Next
  14.     Application.ScreenUpdating = True
复制代码
 楼主| 发表于 2014-1-8 11:40 | 显示全部楼层
根据楼上大哥提供代码,自行修改。并解决闪屏问题·····
    Application.ScreenUpdating = False
    For i = 0 To 9 '复制1-10次
        Sheets("数据连接").Range("bg" & 5 + i * 13 & ":bn" & 14 + i * 13).Copy   '复制
        Sheets("送货单").Range("an" & 11 + i * 13).PasteSpecial Paste:=xlPasteValuesAndNumberFormats  '黏贴
    Next
    Application.ScreenUpdating = True
请大虾们提出跟好意见货建议提供学习
回复

使用道具 举报

发表于 2014-1-7 18:36 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2014-1-7 19:00 来自手机 | 显示全部楼层
yuan1987 发表于 2014-1-7 18:36
是要简化代码么,给个附件哈

刚刚下班,文件存在公司电脑,代码是用按钮运行的,需要简化
回复

使用道具 举报

发表于 2014-1-7 19:39 | 显示全部楼层    本楼为最佳答案   
  1.     Dim shtSj As Worksheet
  2.     Dim shtShd As Worksheet
  3.     Set shtSj = Worksheets("数据连接")
  4.     Set shtShd = Worksheets("送货单")
  5.     Dim i As Byte
  6.     Dim iRow1%
  7.     Application.ScreenUpdating = False
  8.     For i = 0 To 9
  9.         iRow1 = i * 13
  10.         shtSj.Range("bg" & 5 + iRow1 & ":bn" & 14 + iRow1).Copy
  11.         shtShd.Range("an" & 11 + iRow1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
  12.         'Debug.Print shtSj.Range("bg" & 5 + iRow1 & ":bn" & 14 + iRow1).Address, shtShd.Range("an" & 11 + iRow1).Address
  13.     Next
  14.     Application.ScreenUpdating = True
复制代码

评分

参与人数 1 +1 收起 理由
fcdd + 1 赞一个!

查看全部评分

回复

使用道具 举报

发表于 2014-1-7 19:43 | 显示全部楼层
  1.     Dim shtSj As Worksheet, shtShd As Worksheet
  2.     Set shtSj = Worksheets("数据连接")
  3.     Set shtShd = Worksheets("送货单")
  4.     Dim i As Byte, iRow1%
  5.     Application.ScreenUpdating = False
  6.     For i = 0 To 9
  7.         iRow1 = i * 13
  8.         shtSj.Range("bg" & 5 + iRow1 & ":bn" & 14 + iRow1).Copy
  9.         shtShd.Range("an" & 11 + iRow1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
  10.         Debug.Print shtSj.Range("bg" & 5 + iRow1 & ":bn" & 14 + iRow1).Address(False, False), shtShd.Range("an" & 11 + iRow1).Address(False, False)
  11.         '立即窗口的输出是为了检测单元格的地址,无误后可注释掉。
  12.     Next
  13.     Application.ScreenUpdating = True
复制代码
回复

使用道具 举报

 楼主| 发表于 2014-1-7 20:32 来自手机 | 显示全部楼层
hwc2ycy 发表于 2014-1-7 19:43

需要简化,请帮忙,谢谢
回复

使用道具 举报

发表于 2014-1-7 20:42 | 显示全部楼层
fcdd 发表于 2014-1-7 20:32
需要简化,请帮忙,谢谢

不是贴了代码了么。
回复

使用道具 举报

 楼主| 发表于 2014-1-7 21:03 来自手机 | 显示全部楼层
hwc2ycy 发表于 2014-1-7 20:42
不是贴了代码了么。

我需要简化
回复

使用道具 举报

发表于 2014-1-7 21:10 | 显示全部楼层
fcdd 发表于 2014-1-7 21:03
我需要简化

都已经简化了,还咱简化,再简化,你就DIM语句都去掉吧。

回复

使用道具 举报

 楼主| 发表于 2014-1-8 09:31 | 显示全部楼层
本帖最后由 fcdd 于 2014-1-8 09:39 编辑
hwc2ycy 发表于 2014-1-7 19:43

大哥对不起····昨晚是有手机上网的···没看到代码···对不起····

还有个要就···就是求解释  红色就解
Dim iRow1%
    Application.ScreenUpdating = False
    For i = 0 To 9
        iRow1 = i * 13
        shtSj.Range("bg" & 5 + iRow1 & ":bn" & 14 + iRow1).Copy

立即窗口的输出是为了检测单元格的地址,无误后可注释掉,代表那里
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-27 04:40 , Processed in 0.441518 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表