Excel精英培训网

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

[已解决]急求高手指点: VBA 实现工作表sheet(1)公式自动根据sheet(2)中的有值行数自动填充

[复制链接]
发表于 2013-3-28 22:37 | 显示全部楼层 |阅读模式
新手急求高手指点一个关于公式自动填充问题:

实现
1)点击Marco 后,可以把工作表"MTDsales.XLS"上的数据自动复制更新到工作表("PRC order controlworkingfile.xlsx")sheet("MTD sales")中.
2) r = 工作表("PRC order controlworkingfile.xlsx")sheet("MTD sales")中的C12:C列往下有值的列的count值

2).工作表("PRC order controlworkingfile.xlsx")sheet (MTD sales by plant)中 "A1:B1"的公式自动往下填充到 "A &r : B &r"


如下是刚编的程序, 涂红色字体中的 r  值运算不出来,不知道为什么? 求高手帮忙. 非常感谢!!!

Sub PRCordcontrol()
On Error Resume Next
Dim myapp2 As Object
Dim wkb1 As Object, wkb3 As Object
Dim r As Long, j As Integer
Set myapp = CreateObject("Excel.Application")
Set wkb1 = myapp.Workbooks.Open("C:\Documents and Settings\10172999\Desktop\MTDsales.XLS") '打开工作表"MTDsales.xls"
Set wkb3 = myapp.Workbooks.Open("C:\Documents and Settings\10172999\Desktop\PRC order controlworkingfile.xlsx") ''打开工作表 "PRC order controlworkingfile.xlsx"
wkb1.Sheets("MTDsales").Cells.Copy wkb3.Sheets("MTD sales").Range("A1") '工作表"MTDsales.xls"中的数据(整个sheet内容)复制到工作表"PRC order controlworkingfile.xlsx"中的sheet("MTD sales")
Application.CutCopyMode = True

wkb3.Sheets("MTD sales").Activate '激活 wkb3
wkb3.Sheets("MTD sales").Range("C12:C" & Range("c1048576").End(xlUp)).Select ' 选择wkb3工作表中的 C12至C列有数据的最后一行

r = wkb3.Sheets("MTD sales").Selection.Rows.Count 'C12至C列有数据的最后一行付值给 r
wkb3.Sheets("MTD sales total").Activate ' 激活wkb3.Sheets("MTD sales total")
wkb3.Sheets("MTD sales total").Range("A1:C1").Copy '复制wkb3.Sheets("MTD sales total")"A1:C1" (主要为复制公式)
wkb3.Sheets("MTD sales total").Range("A2:H" & r).PasteSpecial -4123 '把复制的"A1:C1"的公式填充到 A2:H2列 往下至 最后一行有数值的单元格 (其中的r值会经常更新).
wkb3.Sheets("MTD sales total").Range("A2:H" & r).PasteSpecial -4122 '把复制的"A1:C1"的格式填充到 A2:H2列 往下至 最后一行有数值的单元格 (其中的r值会经常更新).


wkb3.SaveAs Filename:="C:\Documents and Settings\10172999\Desktop\Macro\PRC order control\" & "PRC Order Control" & Format(Now(), "YYYYMMDDHH") & " .xlsx" '保存单元格
wkb1.Close 0
wkb2.Close 0
wkb3.Close 0
Set wkb1 = Nothing
Set wkb2 = Nothing
Set wkb3 = Nothing



最佳答案
2013-3-29 13:53
Sub test()
    Set myapp = CreateObject("Excel.Application")
    Set wkb1 = myapp.Workbooks.Open(ThisWorkbook.Path & "\MTDsales.XLS")
    Set wkb3 = myapp.Workbooks.Open(ThisWorkbook.Path & "\PRC order controlworkingfile.xlsx")
    wkb1.Sheets("MTDsales").Cells.Copy wkb3.Sheets("MTD sales").Range("A1")
    r = wkb3.Sheets("MTD sales").Range("c1048576").End(xlUp).Row - 11
    With wkb3.Sheets("MTD sales by plant")
        .Range("A1:B1").AutoFill Destination:=.Range("A1:B" & r), Type:=xlFillDefault
    End With
    wkb3.SaveAs Filename:=ThisWorkbook.Path & "PRC Order Control" & Format(Now(), "YYYYMMDDHH") & " .xlsx"
    wkb1.Close 0
    wkb3.Close 0
    Set wkb1 = Nothing
    Set wkb3 = Nothing
    Set myapp2 = Nothing
End Sub

VBA 公式填充(求高手帮忙).zip

108.01 KB, 下载次数: 25

发表于 2013-3-28 22:39 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2013-3-28 22:45 | 显示全部楼层
wkb3.Sheets("MTD sales").Range("C12:C" & Range("c1048576").End(xlUp)).Select
r = wkb3.Sheets("MTD sales").Selection.Rows.Count

如上的 r 值用 "msgbox r" 后老是取值不出来, 一直找不到原因, 不知会有其它办法可以实现的吗?
回复

使用道具 举报

发表于 2013-3-29 08:13 | 显示全部楼层
本帖最后由 zjdh 于 2013-3-29 08:20 编辑

wkb3.Sheets("MTD sales").Range("C12:C" & Range("c1048576").End(xlUp).Row).Select
r = Selection.Rows.Count

另外
PRC order controlworkingfile.xlsx 中不存在 "MTD sales total" 工作表!
回复

使用道具 举报

 楼主| 发表于 2013-3-29 12:11 | 显示全部楼层
zjdh 发表于 2013-3-29 08:13
wkb3.Sheets("MTD sales").Range("C12:C" & Range("c1048576").End(xlUp).Row).Select
r = Selection.Row ...

谢谢! 刚有从新更新一下代码, 发现还是 不能跑出 r 值进行自动复制填充. 不知可以再帮忙吗? 谢谢!

Sub PRCordcontrol()
On Error Resume Next
Dim myapp2 As Object
Dim wkb1 As Object, wkb3 As Object
Dim r As Long, j As Integer
Set myapp = CreateObject("Excel.Application")
Set wkb1 = myapp.Workbooks.Open("C:\Documents and Settings\10172999\Desktop\MTDsales.XLS") '打开工作表"MTDsales.xls"
Set wkb3 = myapp.Workbooks.Open("C:\Documents and Settings\10172999\Desktop\PRC order controlworkingfile.xlsx") '打开工作表 "PRC order controlworkingfile.xlsx"
wkb1.Sheets("MTDsales").Cells.Copy wkb3.Sheets("MTD sales").Range("A1") '工作表"MTDsales.xls"中的数据(整个sheet内容)复制到工作表"PRC order controlworkingfile.xlsx"中的sheet("MTD sales")
Application.CutCopyMode = True

wkb3.Sheets("MTD sales").Activate '激活 wkb3
wkb3.Sheets("MTD sales").Range("C12:C" & Range("c1048576").End(xlUp).Row).Select ' 选择wkb3工作表中的 C12至C列有数据的最后一行
r = Selection.Rows.Count '  C12至C列有数据的最后一行付值给 r
MsgBox r
wkb3.Sheets("MTD sales by plant").Activate ' 激活wkb3.Sheets("MTD sales total")
wkb3.Sheets("MTD sales by plant").Range("A1:B1").Copy '复制wkb3.Sheets("MTD sales total")"A1:C1" (主要为复制公式)
wkb3.Sheets("MTD sales by plant").Range("A1:B" & r).PasteSpecial -4123 '把复制的"A1:C1"的公式填充到 A2:H2列 往下至 最后一行有数值的单元格 (其中的r值会经常更新).
wkb3.Sheets("MTD sales by plant").Range("A1:B" & r).PasteSpecial -4122 '把复制的"A1:C1"的格式填充到 A2:H2列 往下至 最后一行有数值的单元格 (其中的r值会经常更新).

wkb3.SaveAs Filename:="C:\Documents and Settings\10172999\Desktop\" & "PRC Order Control" & Format(Now(), "YYYYMMDDHH") & " .xlsx" '保存单元格
wkb1.Close 0
wkb2.Close 0
wkb3.Close 0
Set wkb1 = Nothing
Set wkb2 = Nothing
Set wkb3 = Nothing
Set myapp2 = Nothing
End Sub

VBA.zip

108.28 KB, 下载次数: 6

回复

使用道具 举报

发表于 2013-3-29 13:19 | 显示全部楼层
本帖最后由 zjdh 于 2013-3-29 13:23 编辑

你只想要“r“的值,就用以下语句
r = wkb3.Sheets("MTD sales").Range("C1048576").End(xlUp).Row - 11

这3句都不要了
wkb3.Sheets("MTD sales").Activate
wkb3.Sheets("MTD sales").Range("C12:C" & Range("c1048576").End(xlUp).Row).Select
r = Selection.Rows.Count
回复

使用道具 举报

 楼主| 发表于 2013-3-29 13:44 | 显示全部楼层
zjdh 发表于 2013-3-29 13:19
你只想要“r“的值,就用以下语句
r = wkb3.Sheets("MTD sales").Range("C1048576").End(xlUp).Row - 11
...

终于可以运行了,省去很多copy paste 的工作, 太感谢您了!

稍有些困惑的是:

Range("C1048576").End(xlUp).Row  按理解是 Excel 表格C行最后一格 C1048576  往上第一个出现值的非空单元格位置.

如下编码是 C1048576  往上到第一次出现值的非空单元格位置再往下11行?
不好意思,新手上路,还望不吝教诲,谢谢您!

r = wkb3.Sheets("MTD sales").Range("C1048576").End(xlUp).Row - 11
回复

使用道具 举报

发表于 2013-3-29 13:52 | 显示全部楼层
BrianBrian 发表于 2013-3-29 13:44
终于可以运行了,省去很多copy paste 的工作, 太感谢您了!

稍有些困惑的是:

你不是需要从C12到最后一行的行数吗?这样计算不就得到啦!
回复

使用道具 举报

发表于 2013-3-29 13:53 | 显示全部楼层    本楼为最佳答案   
Sub test()
    Set myapp = CreateObject("Excel.Application")
    Set wkb1 = myapp.Workbooks.Open(ThisWorkbook.Path & "\MTDsales.XLS")
    Set wkb3 = myapp.Workbooks.Open(ThisWorkbook.Path & "\PRC order controlworkingfile.xlsx")
    wkb1.Sheets("MTDsales").Cells.Copy wkb3.Sheets("MTD sales").Range("A1")
    r = wkb3.Sheets("MTD sales").Range("c1048576").End(xlUp).Row - 11
    With wkb3.Sheets("MTD sales by plant")
        .Range("A1:B1").AutoFill Destination:=.Range("A1:B" & r), Type:=xlFillDefault
    End With
    wkb3.SaveAs Filename:=ThisWorkbook.Path & "PRC Order Control" & Format(Now(), "YYYYMMDDHH") & " .xlsx"
    wkb1.Close 0
    wkb3.Close 0
    Set wkb1 = Nothing
    Set wkb3 = Nothing
    Set myapp2 = Nothing
End Sub
回复

使用道具 举报

 楼主| 发表于 2013-3-29 13:58 | 显示全部楼层
更为简化清晰, 太谢谢了!!
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 01:00 , Processed in 0.540031 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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