ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 194|回复: 8

[求助] 代码优化

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-10 20:22 | 显示全部楼层 |阅读模式
请老师帮忙优化“覆盖图示”中的代码部分代码如下(F1到F49为变量):

With Sheets("覆盖图示")
    .Cells(2, 2) = F1: .Cells(2, 3) = F2: .Cells(3, 2) = F3: .Cells(3, 3) = F4: .Cells(3, 4) = F5: .Cells(3, 5) = F6
    .Cells(4, 2) = F7: .Cells(4, 3) = F8: .Cells(4, 4) = F9: .Cells(4, 5) = F10: .Cells(4, 6) = F11: .Cells(4, 7) = F12: .Cells(4, 8) = F13: .Cells(4, 9) = F14
    .Cells(5, 2) = F15: .Cells(5, 3) = F16: .Cells(5, 4) = F17: .Cells(5, 5) = F18: .Cells(5, 6) = F19: .Cells(5, 7) = F20: .Cells(5, 8) = F21: .Cells(5, 9) = F22
    .Cells(5, 10) = F23: .Cells(5, 11) = F24: .Cells(5, 12) = F25: .Cells(5, 13) = F26
    .Cells(6, 2) = F27: .Cells(6, 3) = F28: .Cells(6, 4) = F29: .Cells(6, 5) = F30: .Cells(6, 6) = F31: .Cells(6, 7) = F32: .Cells(6, 8) = F33: .Cells(6, 9) = F34
    .Cells(6, 10) = F35: .Cells(6, 11) = F36: .Cells(6, 12) = F37
    .Cells(7, 2) = F38: .Cells(7, 3) = F39: .Cells(7, 4) = F40: .Cells(7, 5) = F41: .Cells(7, 6) = F42: .Cells(7, 7) = F43
    .Cells(8, 2) = F44: .Cells(8, 3) = F45: .Cells(8, 4) = F46: .Cells(8, 5) = F47: .Cells(8, 6) = F48: .Cells(8, 7) = F49
End With


网上也找不着,只能求助各位老师咯,谢谢!

检查覆盖表.rar

120.84 KB, 下载次数: 7

TA的精华主题

TA的得分主题

发表于 2020-1-10 23:31 | 显示全部楼层
Dim F1 As Byte, F2 As Byte, F3 As Byte, F4 As Byte, F5 As Byte, F6 As Byte, F7 As Byte, F8 As Byte, F9 As Byte, F10 As Byte
Dim F11 As Byte, F12 As Byte, F13 As Byte, F14 As Byte, F15 As Byte, F16 As Byte, F17 As Byte, F18 As Byte, F19 As Byte, F20 As Byte
Dim F21 As Byte, F22 As Byte, F23 As Byte, F24 As Byte, F25 As Byte, F26 As Byte, F27 As Byte, F28 As Byte, F29 As Byte, F30 As Byte
Dim F31 As Byte, F32 As Byte, F33 As Byte, F34 As Byte, F35 As Byte, F36 As Byte, F37 As Byte, F38 As Byte, F39 As Byte, F40 As Byte
Dim F41 As Byte, F42 As Byte, F43 As Byte, F44 As Byte, F45 As Byte, F46 As Byte, F47 As Byte, F48 As Byte, F49 As Byte
改为
Dim F(1 to 49)


F1 改f(1) .......


1L代码改
clm = Array(, , 3, 5, 9, 13, 12, 7, 7)
With Sheets("覆盖图示")
    k = 0
    For i = 2 To 7
    For j = 2 To clm(i)
        k = k + 1
        .Cells(i, j) = f(k)
    Next j, i
End With

TA的精华主题

TA的得分主题

发表于 2020-1-11 11:05 | 显示全部楼层
本帖最后由 microyip 于 2020-1-11 13:04 编辑
  1. Private Sub CommandButton1_Click()
  2.     Dim wSH As Worksheet
  3.     Dim vData As Variant, vFill As Variant
  4.     Dim nCol As Long, nRow As Long, nI As Long
  5.     Dim dicData As Object, dicSheet As Object
  6.    
  7.     '从填写内容看,就是不同表(7个表)不同行(7行),行数按“项点”对应表的最大序号(12)而定,建立填表数组
  8.     With Application.WorksheetFunction
  9.         vData = Sheets("项点").[A3:A51].Value
  10.         nCol = .Max(.Transpose(vData))
  11.         ReDim vFill(1 To 7, 1 To nCol)
  12.     End With
  13.     vData = Sheets("项点").[A3:D51].Value
  14.     Set dicData = CreateObject("Scripting.Dictionary")
  15.     nCol = 999
  16.     For nI = 1 To UBound(vData)
  17.         If vData(nI, 1) < nCol Then '序号小于存在的行数,表示要换表了
  18.             nRow = nRow + 1 '填表换列
  19.             Set dicData(nRow) = CreateObject("Scripting.Dictionary")
  20.         End If
  21.         nCol = vData(nI, 1)
  22.         dicData(nRow)(vData(nI, 4)) = nCol '记录所在填表所在行数
  23.     Next
  24.     vData = Split("|出勤环节|库内接车环节|出入库调车环节|接、发车环节(含中间站)|运行中作业环节|调车作业环节|站停作业环节", "|")
  25.     Set dicSheet = CreateObject("Scripting.Dictionary")
  26.     For nRow = 1 To UBound(vData)
  27.         dicSheet(vData(nRow)) = nRow '建立每个表所在行
  28.     Next
  29.    
  30.     For Each wSH In Sheets
  31.         With wSH
  32.             If dicSheet.Exists(.Name) Then
  33.                 nRow = dicSheet(.Name) '获取对应表所在行
  34.                 nI = .Cells(.Rows.Count, 11).End(xlUp).Row
  35.                 If nI > 2 Then
  36.                     vData = .Cells(1, 9).Resize(nI).Value
  37.                     For nI = 3 To UBound(vData)
  38.                         If dicData(nRow).Exists(vData(nI, 1)) Then
  39.                             nCol = dicData(nRow)(vData(nI, 1))
  40.                             vFill(nRow, nCol) = vFill(nRow, nCol) + 1
  41.                         End If
  42.                     Next
  43.                 End If
  44.             End If
  45.         End With
  46.     Next
  47.     Sheets("覆盖图示").Cells(2, 2).Resize(UBound(vFill), UBound(vFill, 2)) = vFill
  48.     Application.ScreenUpdating = True
  49. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2020-1-11 11:07 | 显示全部楼层
本帖最后由 microyip 于 2020-1-11 13:04 编辑

附上附件以供参考

检查覆盖表(by.micro).rar

115.33 KB, 下载次数: 4

评分

参与人数 1鲜花 +2 收起 理由
328787483 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-11 12:05 | 显示全部楼层
本帖最后由 328787483 于 2020-1-11 12:09 编辑
microyip 发表于 2020-1-11 11:07
附上附件以供参考

谢谢,老师的帮助,虽然不是很理解,但好像出了点问题,出勤环节只有项点1、2,运行之后出勤环节项点5/6/7也出现的数据。

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-11 12:15 | 显示全部楼层
yjh_27 发表于 2020-1-10 23:31
Dim F1 As Byte, F2 As Byte, F3 As Byte, F4 As Byte, F5 As Byte, F6 As Byte, F7 As Byte, F8 As Byte,  ...

这是把F1到F49看成是数组F,我一直没转过弯来,谢谢老师!

TA的精华主题

TA的得分主题

发表于 2020-1-11 13:05 | 显示全部楼层
328787483 发表于 2020-1-11 12:05
谢谢,老师的帮助,虽然不是很理解,但好像出了点问题,出勤环节只有项点1、2,运行之后出勤环节项点5/6/ ...

把你原来填写的那个行列误解反了,把对应代码对调一下参数就可以了,已经更新代码及附件,重新下载一下即可

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-11 17:20 | 显示全部楼层
microyip 发表于 2020-1-11 13:05
把你原来填写的那个行列误解反了,把对应代码对调一下参数就可以了,已经更新代码及附件,重新下载一下即 ...

谢谢老师

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-11 17:21 | 显示全部楼层
microyip 发表于 2020-1-11 13:05
把你原来填写的那个行列误解反了,把对应代码对调一下参数就可以了,已经更新代码及附件,重新下载一下即 ...

谢谢,老师,太厉害了handshake
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

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

GMT+8, 2020-4-8 20:59 , Processed in 0.097912 second(s), 17 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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