Excel精英培训网

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

[已解决]Excel表格中有很多列都有一同公式,如何用VBA统一实现

[复制链接]
发表于 2014-5-22 10:55 | 显示全部楼层 |阅读模式
本帖最后由 chenlin1106 于 2014-6-10 09:14 编辑

我的Excel表格中有很多列,现在全部都用公式做的,因为数字太多,行和列都有超多数据,所以导致我的表格现在有50多M,打开时很慢,而且以后数据会越来越多

现在有的插入一个模块,用一个表单控件,但是50多个公式就相当于有50多个表单控件

请问有没有一个方法能把这些VBA数据合成,只有一个表单控件,比如命名为计算,那全部都用不同的公式计算出来结果呢?

我现在把表格简化了上传一下,实际表格有50多M,现在想要在第二个表中能插入一个VBA控件,能一次性完成后面所有的公式运算

当然后面每个不同的公式,我会分别加进VBA表格中单独运算

我现在上传的表中从I列到Q列全部是用公式做的,现在麻烦全做成VBA统一实现.

现在上传的麻烦各位先做一个VBA控件,只把现在这几个公式能解决就好.

后面的公式,每个单元格里都能显示,麻烦帮我看下~~谢谢`~
最佳答案
2014-5-26 08:42
如果只要数值,不要公式,可改为:
  1. Sub 引用()
  2.    Worksheets("3D公式预测").Activate
  3.    Dim i As Long, j As Long
  4.    Dim Rng As Range
  5.    Set Rng = Range("A1").CurrentRegion
  6.    Set Rng = Worksheets("3D公式预测").Range("A1").CurrentRegion
  7.    i = Rng.Rows.Count
  8.    j = Rng.Columns.Count
  9.     Worksheets("3D公式预测").Range("i3:q" & j).Clear
  10.    Range("i3").FormulaR1C1 = "=IF(RC3="""","""",SUM(RC3:RC5))"
  11.    Range("J3").FormulaR1C1 = "=IF(RC3="""","""",MAX(RC3:RC5)-MIN(RC3:RC5))"
  12.     Range("K3").FormulaR1C1 = "=RIGHT(RC9,1)"
  13.     Range("L3").FormulaR1C1 = "=CONCATENATE(RC3,RC4,RC5)"
  14.     Range("M3").FormulaR1C1 = "=IF(RC6="""","""",MAX(RC6:RC8)-MIN(RC6:RC8))"
  15.     Range("N3").FormulaR1C1 = _
  16.         "=IF(OR(RC4={1;6}),34,IF(OR(RC4={2;7}),78,IF(OR(RC4={3;8}),12,IF(OR(RC4={4;9}),56,IF(OR(RC4={0;5}),12,IF(RC4="""",""""))))))"
  17.     Range("O3").FormulaR1C1 = _
  18.         "=IF(RC3="""","""",COUNT(FIND(RC3:RC5,MID(RC14,ROW(R1C1:R2C1),1))))"
  19.     Range("P3").FormulaR1C1 = "=IF(RC4="""","""",RIGHT(RC4+2,1))"
  20.     Range("Q3").FormulaR1C1 = _
  21.         "=IF(RC3="""","""",IF(COUNTIF(RC3:RC5,RC16),""×"",""对""))"
  22.    For k = 6 To j
  23.    Cells(3, k).AutoFill _
  24.       Destination:=Range(Cells(3, k), Cells(i, k))
  25.    Next
  26.    Range("I3:Q" & i).Select
  27.     Selection.Copy
  28.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  29.         :=False, Transpose:=False
  30.     Application.CutCopyMode = False
  31.     ActiveWorkbook.Save
  32. End Sub
复制代码

3D预测.zip

19.67 KB, 下载次数: 18

发表于 2014-5-22 11:40 | 显示全部楼层
本帖最后由 ppp710715 于 2014-5-22 12:32 编辑
  1. Sub 引用()
  2.    Worksheets("3D公式预测").Activate
  3.    Dim i As Long
  4.    Dim Rng As Range
  5.    Set Rng = Range("A1").CurrentRegion
  6.    Set Rng = Worksheets("3D公式预测").Range("A1").CurrentRegion
  7.    Range("i3").FormulaR1C1 = "=IF(RC3="""","""",SUM(RC3:RC5))"
  8.    Range("J3").FormulaR1C1 = "=IF(RC3="""","""",MAX(RC3:RC5)-MIN(RC3:RC5))"
  9.     Range("K3").FormulaR1C1 = "=RIGHT(RC9,1)"
  10.     Range("L3").FormulaR1C1 = "=CONCATENATE(RC3,RC4,RC5)"
  11.     Range("M3").FormulaR1C1 = "=IF(RC6="""","""",MAX(RC6:RC8)-MIN(RC6:RC8))"
  12.     Range("N3").FormulaR1C1 = _
  13.         "=IF(OR(RC4={1;6}),34,IF(OR(RC4={2;7}),78,IF(OR(RC4={3;8}),12,IF(OR(RC4={4;9}),56,IF(OR(RC4={0;5}),12,IF(RC4="""",""""))))))"
  14.     Range("O3").FormulaR1C1 = _
  15.         "=IF(R[1]C3="""","""",COUNT(FIND(R[1]C3:R[1]C5,MID(RC14,ROW(R1C1:R2C1),1))))"
  16.     Range("P3").FormulaR1C1 = "=IF(RC4="""","""",RIGHT(RC4+2,1))"
  17.     Range("Q3").FormulaR1C1 = _
  18.         "=IF(R[1]C3="""","""",IF(COUNTIF(R[1]C3:R[1]C5,RC16),""×"",""对""))"
  19.    i = Rng.Rows.Count
  20.    j = Rng.Columns.Count
  21.    For k = 6 To j
  22.    Cells(3, k).AutoFill _
  23.       Destination:=Range(Cells(3, k), Cells(i, k))
  24.    Next
  25. End Sub

复制代码
回复

使用道具 举报

发表于 2014-5-22 12:28 | 显示全部楼层
完善一下。附件附后
  1. Sub 引用()
  2.    Worksheets("3D公式预测").Activate
  3.    Dim i As Long, j As Long
  4.    Dim Rng As Range
  5.    Set Rng = Range("A1").CurrentRegion
  6.    Set Rng = Worksheets("3D公式预测").Range("A1").CurrentRegion
  7.    i = Rng.Rows.Count
  8.    j = Rng.Columns.Count
  9.     Worksheets("3D公式预测").Range("i3:q" & j).Clear
  10.    Range("i3").FormulaR1C1 = "=IF(RC3="""","""",SUM(RC3:RC5))"
  11.    Range("J3").FormulaR1C1 = "=IF(RC3="""","""",MAX(RC3:RC5)-MIN(RC3:RC5))"
  12.     Range("K3").FormulaR1C1 = "=RIGHT(RC9,1)"
  13.     Range("L3").FormulaR1C1 = "=CONCATENATE(RC3,RC4,RC5)"
  14.     Range("M3").FormulaR1C1 = "=IF(RC6="""","""",MAX(RC6:RC8)-MIN(RC6:RC8))"
  15.     Range("N3").FormulaR1C1 = _
  16.         "=IF(OR(RC4={1;6}),34,IF(OR(RC4={2;7}),78,IF(OR(RC4={3;8}),12,IF(OR(RC4={4;9}),56,IF(OR(RC4={0;5}),12,IF(RC4="""",""""))))))"
  17.     Range("O3").FormulaR1C1 = _
  18.         "=IF(R[1]C3="""","""",COUNT(FIND(R[1]C3:R[1]C5,MID(RC14,ROW(R1C1:R2C1),1))))"
  19.     Range("P3").FormulaR1C1 = "=IF(RC4="""","""",RIGHT(RC4+2,1))"
  20.     Range("Q3").FormulaR1C1 = _
  21.         "=IF(R[1]C3="""","""",IF(COUNTIF(R[1]C3:R[1]C5,RC16),""×"",""对""))"
  22.    For k = 6 To j
  23.    Cells(3, k).AutoFill _
  24.       Destination:=Range(Cells(3, k), Cells(i, k))
  25.    Next
  26. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2014-5-26 00:52 | 显示全部楼层
ppp710715 发表于 2014-5-22 12:28
完善一下。附件附后

谢谢你,但这个代码用了后发现在表格里面还是公式,能不能直接显示结果了呢?
回复

使用道具 举报

发表于 2014-5-26 08:42 | 显示全部楼层    本楼为最佳答案   
如果只要数值,不要公式,可改为:
  1. Sub 引用()
  2.    Worksheets("3D公式预测").Activate
  3.    Dim i As Long, j As Long
  4.    Dim Rng As Range
  5.    Set Rng = Range("A1").CurrentRegion
  6.    Set Rng = Worksheets("3D公式预测").Range("A1").CurrentRegion
  7.    i = Rng.Rows.Count
  8.    j = Rng.Columns.Count
  9.     Worksheets("3D公式预测").Range("i3:q" & j).Clear
  10.    Range("i3").FormulaR1C1 = "=IF(RC3="""","""",SUM(RC3:RC5))"
  11.    Range("J3").FormulaR1C1 = "=IF(RC3="""","""",MAX(RC3:RC5)-MIN(RC3:RC5))"
  12.     Range("K3").FormulaR1C1 = "=RIGHT(RC9,1)"
  13.     Range("L3").FormulaR1C1 = "=CONCATENATE(RC3,RC4,RC5)"
  14.     Range("M3").FormulaR1C1 = "=IF(RC6="""","""",MAX(RC6:RC8)-MIN(RC6:RC8))"
  15.     Range("N3").FormulaR1C1 = _
  16.         "=IF(OR(RC4={1;6}),34,IF(OR(RC4={2;7}),78,IF(OR(RC4={3;8}),12,IF(OR(RC4={4;9}),56,IF(OR(RC4={0;5}),12,IF(RC4="""",""""))))))"
  17.     Range("O3").FormulaR1C1 = _
  18.         "=IF(RC3="""","""",COUNT(FIND(RC3:RC5,MID(RC14,ROW(R1C1:R2C1),1))))"
  19.     Range("P3").FormulaR1C1 = "=IF(RC4="""","""",RIGHT(RC4+2,1))"
  20.     Range("Q3").FormulaR1C1 = _
  21.         "=IF(RC3="""","""",IF(COUNTIF(RC3:RC5,RC16),""×"",""对""))"
  22.    For k = 6 To j
  23.    Cells(3, k).AutoFill _
  24.       Destination:=Range(Cells(3, k), Cells(i, k))
  25.    Next
  26.    Range("I3:Q" & i).Select
  27.     Selection.Copy
  28.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  29.         :=False, Transpose:=False
  30.     Application.CutCopyMode = False
  31.     ActiveWorkbook.Save
  32. End Sub
复制代码
回复

使用道具 举报

发表于 2014-5-26 08:43 | 显示全部楼层
chenlin1106 发表于 2014-5-26 00:52
谢谢你,但这个代码用了后发现在表格里面还是公式,能不能直接显示结果了呢?

已改为只要数值。
回复

使用道具 举报

 楼主| 发表于 2014-6-10 08:49 | 显示全部楼层
ppp710715 发表于 2014-5-26 08:43
已改为只要数值。

谢谢了
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-6-7 08:24 , Processed in 0.264736 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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