ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
数据管理利器Foxtable2022下载 Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 Power Query数据清洗实战攻略 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 134|回复: 6

[求助] 精简压缩代码

[复制链接]

TA的精华主题

TA的得分主题

发表于 2021-11-24 15:32 | 显示全部楼层 |阅读模式
请大师们帮助把下面的代码精简一下:


Sub 八年级成绩计算()
With Sheets("八年级成绩录入")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:zz" & r)
    Dim arr, brr(1 To 60000, 1 To 4), i As Long, j As Long
    End With
    Sheets("成绩").Visible = True
    Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets '历遍工作簿中所有的工作表
    If sh.Name <> "成绩" Then '如果工作表名不是Sheet1的所有工作表隐藏
        sh.Visible = False
    End If
Next
With Sheets("成绩")
.Select
Cells.Select
    Selection.ClearContents
For i = 1 To UBound(ar)
Cells(i, 1) = ar(i, 1)
Cells(i, 2) = ar(i, 2)
Cells(i, 3) = ar(i, 3)
Cells(i, 4) = ar(i, 4)
Cells(i, 5) = ar(i, 5)
Cells(i, 6) = ar(i, 6)
Cells(i, 7) = ar(i, 7)
Cells(i, 8) = ar(i, 8)
Cells(i, 13) = ar(i, 9)
Cells(i, 14) = ar(i, 10)
Cells(i, 15) = ar(i, 11)
Cells(i, 16) = ar(i, 12)
Cells(i, 17) = ar(i, 13)
Cells(i, 18) = ar(i, 14)
Cells(i, 19) = ar(i, 15)
Cells(i, 20) = ar(i, 16)
Cells(i, 21) = ar(i, 17)
Cells(i, 22) = ar(i, 18)
Cells(i, 23) = ar(i, 19)
Cells(i, 24) = ar(i, 20)
Cells(i, 25) = ar(i, 21)
Cells(1, 9) = "县位"
Cells(1, 10) = "校位"
Cells(1, 11) = "班位"
Cells(1, 12) = "总分"
ra = .Cells(Columns.Count, 1).End(xlUp).Column
Cells(i, 12) = Application.Sum(Range("m" & i & ":zz" & i))
Next
End With

TA的精华主题

TA的得分主题

发表于 2021-11-24 16:10 | 显示全部楼层
仅供参考:
  1. Sub 八年级成绩计算()
  2.     Dim ar(), i As Long, j As Long
  3.     Dim sh As Worksheet
  4.     With Sheets("八年级成绩录入")
  5.         ar = .Range("a1:zz" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
  6.     End With
  7.     Sheets("成绩").Visible = True
  8.     For Each sh In ThisWorkbook.Sheets '历遍工作簿中所有的工作表
  9.         If sh.Name <> "成绩" Then '如果工作表名不是Sheet1的所有工作表隐藏
  10.             sh.Visible = False
  11.         End If
  12.     Next
  13.     With Sheets("成绩")
  14.         .Cells.ClearContents
  15.         .Cells(1, 9) = "县位"
  16.         .Cells(1, 10) = "校位"
  17.         .Cells(1, 11) = "班位"
  18.         .Cells(1, 12) = "总分"
  19.         For i = 1 To UBound(ar)
  20.             For j = 1 To 21
  21.                 If j < 9 Then
  22.                     .Cells(i, j) = ar(i, j)
  23.                 Else
  24.                     If j = 12 Then
  25.                         .Cells(i, j + 4) = arr(i, j)
  26.                         .Cells(i, j) = Application.Sum(Range("m" & i & ":zz" & i))
  27.                     Else
  28.                         .Cells(i, j + 4) = arr(i, j)
  29.                     End If
  30.                 End If
  31.             Next j
  32.         Next
  33.     End With
  34. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2021-11-24 16:20 | 显示全部楼层
    With Sheets("八年级成绩录入")
            r = .Cells(Rows.Count, 1).End(xlUp).Row
            ar = .Range("a1:zz" & r)
            Dim arr, brr(1 To 60000, 1 To 4), i As Long, j As Long
    End With
    Sheets("成绩").Visible = True
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Sheets '历遍工作簿中所有的工作表
            If sh.Name <> "成绩" Then '如果工作表名不是Sheet1的所有工作表隐藏
                sh.Visible = False
            End If
    Next
With Sheets("成绩")
        .Select
        Cells.Select
            Selection.ClearContents
        For i = 1 To UBound(ar)
                For x = 1 To 25
                        If x <= 8 Then Cells(i, x) = ar(i, x)
                        If x > 12 And x <= 25 Then Cells(i, x) = ar(i, x - 4)
                        Cells(1, 9) = "县位"
                        Cells(1, 10) = "校位"
                        Cells(1, 11) = "班位"
                        Cells(1, 12) = "总分"
                        ra = .Cells(Columns.Count, 1).End(xlUp).Column
                        Cells(i, 12) = Application.Sum(Range("m" & i & ":zz" & i))
                Next
        Next
End With

TA的精华主题

TA的得分主题

发表于 2021-11-24 16:24 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2021-11-24 16:46 | 显示全部楼层
07年的老人了,居然这样频繁写入单元格,是在熬时间吗,给点修改思路
untitled1.png

TA的精华主题

TA的得分主题

发表于 2021-11-24 16:57 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2021-11-24 17:14 | 显示全部楼层
Sub 八年级成绩计算()
    Dim r&, ar, br, b As Boolean, sh As Worksheet
    With Sheets("八年级成绩录入")
        r = .Cells(Rows.Count, 1).End(xlUp).Row
        ar = .Range("a1:H" & r)
        br = .Range("I1:zz" & r)
    End With
    With Sheets("成绩")
        .Visible = True
        For Each sh In ThisWorkbook.Sheets '历遍工作簿中所有的工作表
            If sh.Name = "成绩" Then sh.Visible = False '如果工作表名没有【成绩"】,所有工作表隐藏
        Next
        .UsedRange.ClearContents
        .Range("A1:H" & r) = ar
        .Range("M1:Y" & r) = br
        .Cells(1, 9) = "县位"
        .Cells(1, 10) = "校位"
        .Cells(1, 11) = "班位"
        .Cells(1, 12) = "总分"
        .Cells(2, 12).Resize(UBound(ar)) = "=SUM(RC[2]:RC[13])"
    End With
End Sub


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

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2021-12-4 03:42 , Processed in 0.072645 second(s), 15 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2021 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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