.threadtags_tag {margin:0px !important;background:none !important;padding:12px 0 !important;color: #444 !important;}.threadtags_tag span {border:1px solid #E3EDF5; padding:10px 14px 10px 32px; background: url(http://images.5d6d.net/dz7/default//tag.gif) no-repeat 10px 50%;}.threadtags_tag a{color:#09C !important;}
本帖最后由 夏之雨 于 2010-5-11 06:39 编辑
VBA自动化复制公式二法
首先感谢“LangQueS”、“富戈”和“zjdh”三位老师不厌其烦的帮助，以及贡献了如此具有划时代意义的思想！
经过验证，只要遵循下面的几条规则以及注意事项，运用这两种方法就完全不会出现任何错误！而且可以提高我们的工作效率十倍、百倍！可以减小我们的文件体积到几十K、几K！
从此我们再不用惆怅于工作表内自编公式繁多带来的种种麻烦，再不用担心Excel文件的庞大！让我们尽情编写公式，因为只需简单的几步VBA修改、粘贴，那些困难将会一扫而光！
当然，现有方法里还有一些未尽完美的地方，需要更多的高手给予指教、修改、完善。我也希望擅长VBA的朋友能编写出一个自动化修改系统，每次弹出几个输入框，只需填入需要修改的部分，然后自动生成新的、适合自己的代码，我们仅仅将代码复制自己的工作表中即可！这应该不难实现，期待有识之士能够早日奉献这样的作品以便不熟悉代码的朋友方便使用！
再次强调一定要遵循下面几条规则，否则将会出现错误！
几条规则：
1、两种方法都要求我们的工作表尽可能的符合这样的排列，即数据列排在最左边，公式列（或者生成结果列）排在所有数据列的后面，当然，如果个别数据列与公式列交替排列也不会出现错误，但会给你的更新数据带来麻烦；
2、两种方法都要求我们的工作表必须避免首列为公式列，如果那样将绝对出现错误；
3、不管是任何方法，建议我们都要养成好的管理数据的习惯，即首行为标题，以下行为数据或公式，数据和公式按同列归类的原则放置，简单说，同一列的公式都是相同的，服从向下填充。
如果你遵循了上述三条规则，那么你可以根据实际需要选择下面任一种方法管理你的公式，但是还应该认真遵循每种方法后面的注意事项，避免意想不到的错误。
最后，再次感谢三位老师！衷心谢谢你们！！！
LangQueS_VBA复制公式法
- Sub LangQueS_VBA复制公式法()
- i = Range("a65536").End(xlUp).Row
- If i =标题行行号，例如1 Then
- Exit Sub
- Else
- Application.ScreenUpdating = False '关闭屏幕刷新
- y = Columns(1).Find("*", , xlValues, , ,2).Row 'A列最后单元行号
- x = [IV标题行行号，例如1].End(xlToLeft).Column '返回第1行最右边非空单元的列号
- For 列 = 1 To x '设置变量，遍历所有列
- If Cells(所有公式列的首行所在的行号，例如2, 列).HasFormula = True Then '确定所有公式列的首行是第几行
- Cells(所有公式列的首行所在的行号，例如2, 列).Copy Range(Cells(所有公式列的首行所在的行号，例如2, 列), Cells(y, 列)) '将该公式列的首行公式复制到以下所有单元格
- Range(Cells(所有公式列的第二行所在的行号，例如3, 列), Cells(y, 列)) = Range(Cells(所有公式列的第二行所在的行号，例如3, 列), Cells(y, 列)).Value '复制粘贴该公式列第三行到最后一行单元格数值
- End If
- Next
- Application.ScreenUpdating = True '打开屏幕刷新
- End If
- End Sub
复制代码
【通用代码】
- Sub LangQueS_VBA复制公式法()
- TextBox1.Visible = True
- i = Range("a65536").End(xlUp).Row
- If i = 1 Then
- Exit Sub
- Else
- Application.ScreenUpdating = False '关闭屏幕刷新
- y = Columns(1).Find("*", , xlValues, , , 2).Row 'A列最后单元行号
- x = [IV1].End(xlToLeft).Column '返回第1行最右边非空单元的列号
- For 列 = 1 To x '设置变量，遍历所有列
- If Cells(2, 列).HasFormula = True Then '确定所有公式列的首行是第几行
- Cells(2, 列).Copy Range(Cells(2, 列), Cells(y, 列)) '将该公式列的首行公式复制到以下所有单元格
- Range(Cells(3, 列), Cells(y, 列)) = Range(Cells(3, 列), Cells(y, 列)).Value '复制粘贴该公式列第三行到最后一行单元格数值
- End If
- TextBox1.Value = String(Int(22 * 列 / x), "■")
- DoEvents
- Next
- Application.ScreenUpdating = True '打开屏幕刷新
- End If
- TextBox1.Visible = False
- MsgBox "运算完毕！ ", 64, " 提示 "
- End Sub
复制代码
注意事项：
1、该方法智能化较高，它要求先确定标题行是第几行以及所有公式列的首行是第几行，每次追加数据后，运行宏，可得到最新的公式计算结果；
2、该方法操作比较简单，只用简单地修改一下代码中的行号即可，免去了输入公式的麻烦；
3、还应注意，首行的公式不要误删，否则将不能识别，产生无法挽回的后果；
富戈_VBA复制公式法
- Sub 富戈_VBA复制公式法()
- Application.ScreenUpdating = False '关闭屏幕刷新
- Dim y As Long
- y = Range("a65536").End(xlUp).Row+1
- Range("第一个公式的位置，例如E2: 第一个公式所在列，例如E" & y) = "复制原单元格第一个公式，例如=ROW()*2" '粘贴公式
- '重复上一步工作，将其它公式一一复制，注意：都是公式首行第一个公式！
- Range("第一个公式的位置，例如E2:
- 最后一个公式所在列，例如J" & y) = Range("第一个公式的位置，例如E2:
- 最后一个公式所在列，例如J " & y).Value '用运算后的数值替代公式
- Rows(y).Delete
- Application.ScreenUpdating = True '打开屏幕刷新
- End Sub
复制代码
注意事项：
1、该方法的优点在于使工作表内看不到任何公式，每次追加数据后，运行宏，可得到最新的公式计算结果；
2、其缺点是，如果公式较多，即使是复制也会花费很长时间，而且要修改的代码比较多。
偶看新闻