ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2094|回复: 3

[讨论] 喜欢玩VBA来练练手

[复制链接]

TA的精华主题

TA的得分主题

发表于 2014-9-11 21:20 | 显示全部楼层 |阅读模式
桌面.rar (12.59 KB, 下载次数: 25)

附件里是一个杂乱的选择题选项,另个是处理好的样本,分为三种情况:
如果选项长度很短,五个加起来还没超过一行,那就单行分布;ABCDE
如果选项很长,两个选项肯定会超过一行,那就每个都占一行;
A
B
C
D
E
如果两个连起来没有超过一行,那就AB一行,CD一行,E单独一行;
制表位距离以自己看着美观和合理来搞。

对VBA有兴趣的可以练习下。
本人这段时间忙,实在没人有能力解决我会考虑给出解决方案.

TA的精华主题

TA的得分主题

发表于 2014-9-14 21:05 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-9-20 22:17 | 显示全部楼层
本帖最后由 zhanglei1371 于 2014-9-21 10:09 编辑

看来对VBA感兴趣的人还是不多啊,本人就亲自解决吧:
  1. Sub sadf()
  2.     Application.ScreenUpdating = 0
  3.     l = ActiveDocument.PageSetup.CharsLine
  4.     For Each pa In ActiveDocument.Paragraphs
  5.         If InStr(pa, "D.") Then
  6.             pa.Range.Select:
  7.             If Len(pa) > l * 2 Then  '长度超过两行就每个选项一行
  8.                 Call A3
  9.             ElseIf Len(pa) < l Then  '长度小于一行就所有选项一行
  10.                 Call a1(l - Len(pa.Range))
  11.             Else   '长度在两行内就AB一行,CD一行,E项单独一行
  12.                 Call a2
  13.             End If
  14.         End If
  15.     Next
  16.     Application.ScreenUpdating = 1
  17. End Sub


  18. Sub a1(n)  '分1行
  19.     s = Selection.End
  20.     i = 1
  21.     With Selection.Find
  22.         .ClearFormatting
  23.         .Text = "[ ]{1,}[B-E]."
  24.         .MatchWildcards = 1
  25.         Do While .Execute
  26.             If .Parent.End > s Then Exit Sub
  27.             '        If a > 1 Then
  28.             .Parent.End = .Parent.End - 2
  29.             .Parent = Chr(9)
  30.             La = Selection.End - Selection.Paragraphs(1).Range.Start + n * i / 4
  31.             Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(La * 15 / 39)
  32.             .Parent.Collapse 0
  33.             i = i + 1
  34.         Loop
  35.     End With
  36. End Sub
  37. Sub a2()  '分三行
  38.     a = 1: i = 1
  39.     s = Selection.End
  40.     With Selection.Find
  41.         .ClearFormatting
  42.         .Text = "B.*C."
  43.         .MatchWildcards = 1
  44.         If .Execute Then
  45.             ac = Len(.Parent) - 2     'B项长度
  46.             ac = (39 - ac)
  47.             .Parent.Collapse 1
  48.         End If
  49.         .Text = "D.*E."
  50.         .MatchWildcards = 1
  51.         If .Execute Then
  52.             cd = Len(.Parent) - 2   'D项长度
  53.             cd = (39 - cd)
  54.             min = ac
  55.             If min > cd Then min = cd - 7
  56.             If min > 20 Then min = 20
  57.             .Parent.HomeKey
  58.         End If

  59.         .Text = "[ ]{1,}[B-E]."
  60.         .MatchWildcards = 1
  61.         Do While .Execute
  62.             If .Parent.End > s Then Exit Sub
  63.             .Parent.End = .Parent.End - 2
  64.             If a / 2 = Int(a / 2) Then
  65.                 .Parent = Chr(13)    '若是CE则加入回车
  66.             Else
  67.                 .Parent = Chr(9)  '若是BD项则加入tab
  68.                 Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(min * 15 / 39)
  69.             End If
  70.             a = a + 1
  71.             .Parent.Collapse 0
  72.             i = i + 1
  73.         Loop
  74.     End With
  75. End Sub
  76. Sub A3()    '分5行
  77.     s = Selection.End
  78.     a = 1
  79.     With Selection.Find
  80.         .ClearFormatting
  81.         .Text = "[A-E]."
  82.         .MatchWildcards = 1
  83.         Do While .Execute
  84.             If .Parent.End > s Then Exit Sub
  85.             If a > 1 Then
  86.                 .Parent = Chr(13) & .Parent
  87.                 .Parent.Collapse 0

  88.             End If
  89.             a = a + 1
  90.         Loop
  91.     End With
  92. End Sub

复制代码


TA的精华主题

TA的得分主题

发表于 2014-9-21 20:23 | 显示全部楼层
学习了,重点在几个表达式。加紧学习跟上脚步
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2025-1-16 20:08 , Processed in 0.021702 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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