[已解决]求高手进一步优化附件里面的代码。感激。就差一点了！

富士康 · 发表于 2011-12-30 09:49

指定区域自动排序.rar (32.66 KB, 下载次数: 11)

菜鸟锐 · 发表于 2011-12-30 09:59

是否可以考虑在代码直接把那些公式列的公式纳进去参与计算。这样就不需要在表格里面计算了。
导出的数据不单是表格2的数据，也同时进行计算和排序。

adders · 发表于 2011-12-30 10:16

指定区域自动排序.rar (32.92 KB, 下载次数: 13)

kamei · 发表于 2011-12-30 10:22

程序没什么改得
只是排序的时候对  ""排序在前面 (我不会在vba改)
总分列  公式
=IF(OR($D11="",$E11="",$F11=""),0,IF(ISERROR($H11+$J11+$L11+$N11+$P11+$R11),0,$H11+$J11+$L11+$N11+$P11+$R11))
全是零就好了
单元格公式定义为  0.0000;0.0000;"";
再排序

菜鸟锐 · 发表于 2011-12-30 10:38

kamei 发表于 2011-12-30 10:22
程序没什么改得
只是排序的时候对 ""排序在前面 (我不会在vba改)
总分列公式

这个方法可行，但从学习VBA的角度来说，我还是觉得优化代码是一个更好的方法

kamei · 发表于 2011-12-30 17:58

菜鸟锐发表于 2011-12-30 10:38
这个方法可行，但从学习VBA的角度来说，我还是觉得优化代码是一个更好的方法

嗯嗯
我是vba菜
搞不出来vba的方法

zjdh · 发表于 2011-12-30 19:00

本帖最后由 zjdh 于 2011-12-31 14:27 编辑

指定区域自动排序.rar (30.22 KB, 下载次数: 15)

菜鸟锐 · 发表于 2011-12-31 09:08

试一下这段代码，我试过后可以。。。。。导入后同时排序，无需双击条件列。
Sub 按钮5_Click()
With Sheets("Sheet1")
      .Range("d11:g110").Value = Sheets("Sheet2").Range("b4:e103").Value
      .Range("i11:i110").Value = Sheets("Sheet2").Range("f4:f103").Value
      .Range("k11:k110").Value = Sheets("Sheet2").Range("g4:g103").Value
      .Range("m11:m110").Value = Sheets("Sheet2").Range("h4:h103").Value
      .Range("o11:o110").Value = Sheets("Sheet2").Range("i4:i103").Value
      .Range("q11:q110").Value = Sheets("Sheet2").Range("j4:j103").Value
      .Range("S11").AutoFill Destination:=.Range("S11:S110"), Type:=xlFillDefault
      For I = 11 To 110
         If .Range("S" & I).Value = "" Then Exit For
      Next
      .Range("S" & I & ":S110").ClearContents
      .Range("D11:T" & .Range("S111").End(3).Row).Sort Key1:=.Range("S12"), Order1:=xlDescending, Header:=xlGuess
End With
End Sub

zjdh · 发表于 2011-12-31 14:25

可以简化一下：
Sub 按钮5_Click()
With Sheets("Sheet1")
      .Range("d11:g110").Value = Sheets("Sheet2").Range("b4:e103").Value
      .Range("i11:i110").Value = Sheets("Sheet2").Range("f4:f103").Value
      .Range("k11:k110").Value = Sheets("Sheet2").Range("g4:g103").Value
      .Range("m11:m110").Value = Sheets("Sheet2").Range("h4:h103").Value
      .Range("o11:o110").Value = Sheets("Sheet2").Range("i4:i103").Value
      .Range("q11:q110").Value = Sheets("Sheet2").Range("j4:j103").Value
      For I = 11 To 110
         If .Range("S" & I).Value = "" Then Exit For
      Next
      .Range("D11:T" & I - 1).Sort Key1:=.Range("S12"), Order1:=xlDescending, Header:=xlGuess
End With
End Sub

		自动登录	找回密码
密码			注册

[已解决]求高手进一步优化附件里面的代码。感激。就差一点了！

相关帖子