Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

工作中常用的Excel函数公式,全印在一张超大鼠标垫上
查看: 199|回复: 2

[已解决]跨表复制单元格内容

[复制链接]
发表于 2021-2-24 20:53 | 显示全部楼层 |阅读模式

      综合表里A列与分类统计表F列数值相等时,将分类统计表G列--AA列的数据,复制到综合表的F列后边。
      问题:1、日期复制后格式不对。
                2、被复制的单元格的背景色过不去。

请教老师给予 指导!谢谢!

Sub 倒数据搬家()
    Dim x As Long, y As Long, i As Long, h As Long
        i = Sheet2.Range("g65536").End(xlUp).Row
        h = Sheet5.Range("d65536").End(xlUp).Row
        For x = 1 To i
          For y = 4 To h
            If Trim(Sheet2.Cells(x, "F")) = Trim(Sheet5.Cells(y, "A")) Then
                For k = 0 To 20
                 Sheet5.Cells(y, 6 + k) = Sheet2.Cells(x, 7 + k)
                Next k
            End If
          Next y
        Next x
    MsgBox "执行完毕!"
End Sub

最佳答案
2021-2-24 22:03
Sub 倒数据搬家()

   Application.ScreenUpdating = False

   Dim x As Long, y As Long, i As Long, h As Long

   i = Sheet2.Range("g65536").End(xlUp).Row
   h = Sheet5.Range("d65536").End(xlUp).Row

   Set d = CreateObject("Scripting.Dictionary")
   For y = 4 To h
      d(Trim(Sheet5.Cells(y, "A"))) = y
   Next

   For x = 1 To i
      Key = Trim(Sheet2.Cells(x, "F").Value)
      If d.exists(Key) Then
         y = d(Key)
         Sheet2.Range(Sheet2.Cells(x, 7), Sheet2.Cells(x, 27)).Copy
         Sheet5.Cells(y, 6).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
         Sheet5.Cells(y, 6).PasteSpecial Paste:=xlPasteFormats
         Application.CutCopyMode = False
      End If
   Next x

   MsgBox "执行完毕!"

End Sub

祝順心,南無阿彌陀佛!

石家庄的鸟 - 专用 -改动.rar

136.52 KB, 下载次数: 8

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2021-2-24 22:03 | 显示全部楼层    本楼为最佳答案   
Sub 倒数据搬家()

   Application.ScreenUpdating = False

   Dim x As Long, y As Long, i As Long, h As Long

   i = Sheet2.Range("g65536").End(xlUp).Row
   h = Sheet5.Range("d65536").End(xlUp).Row

   Set d = CreateObject("Scripting.Dictionary")
   For y = 4 To h
      d(Trim(Sheet5.Cells(y, "A"))) = y
   Next

   For x = 1 To i
      Key = Trim(Sheet2.Cells(x, "F").Value)
      If d.exists(Key) Then
         y = d(Key)
         Sheet2.Range(Sheet2.Cells(x, 7), Sheet2.Cells(x, 27)).Copy
         Sheet5.Cells(y, 6).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
         Sheet5.Cells(y, 6).PasteSpecial Paste:=xlPasteFormats
         Application.CutCopyMode = False
      End If
   Next x

   MsgBox "执行完毕!"

End Sub

祝順心,南無阿彌陀佛!

评分

参与人数 1学分 +2 收起 理由
凤鸣岐山 + 2 学习了

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2021-2-25 07:48 | 显示全部楼层
cutecpu 发表于 2021-2-24 22:03
Sub 倒数据搬家()

   Application.ScreenUpdating = False

感谢 老师深夜指导!非常好,我没学过字典,有程序了,结合百度,慢慢消化老师给的语句!谢谢!

阿弥陀佛!随喜功德!!!

评分

参与人数 1学分 +2 收起 理由
cutecpu + 2 不客氣。祝順心,南無阿彌陀佛!

查看全部评分

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2021-4-20 05:53 , Processed in 0.124800 second(s), 8 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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