ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[Word 应用与开发] [第6期] WORD表格空行删除和零值填充[已完成]

[复制链接]

TA的精华主题

TA的得分主题

发表于 2005-12-1 13:18 | 显示全部楼层 |阅读模式

题目要求:


这是一个10*192行的表格(见附件),表格中充斥着一些数据。


如果一行中的10列全部为空白单元格,则删除这些空白行;


如果不是空白行,则将其中的空白单元格中填充0值。


整理结束后的表格惺??lt;FONT face=Tahoma>4倍数中的单元格文字为加粗格式.


表格的列宽分别为2,1.5,2.5,2.5,1.5,1,1.5,2,1.5,4厘米,首行重复标题行。


说明:

可以使用查找与替换操作进行,也可以使用VBA进行,两者全部实现者分别计分,借助EXCEL完成者不计分。如果是VBA,请附上代码;如果是查找与替换操作,必须说明详细操作步骤。

附件如下:



VBA的方法:

Option Explicit
Sub Word6VBA()
Dim myTable As Table, oRow As Row, oCell As Cell
Application.ScreenUpdating = False
Set myTable = ActiveDocument.Tables(1)
For Each oRow In myTable.Rows
With oRow
If Len(.Range) = 22 Then '每个空白单元格长度为2(CHR(7)+CHR(13)),加上一个行结束标记为2字节
.Delete '删除空行
Else
For Each oCell In .Cells '在行单元格中循环
If Len(oCell.Range) = 2 Then oCell.Range = "0"
Next
If .Index Mod 4 = 0 Then .Range.Font.Bold = True '行号逢四整除者字体加粗
End If
End With
Next
Application.ScreenUpdating = True
End Sub
在题中,实际上已设置了标题行重复和各固定了各列列宽,这些数据是为以手动查找与替换过程中的再次设置而定的,在下面的查找与替换中,将会用到,在VBA中可以不予设置。

查找与替换:

1. 新建一个空白文档,将表格复制于空白文档中,以制表位为分隔符,表格转换为文本.

2. CTRL+H,勾选通配符,查找"^t{9}^13",替换为"",把所有"空行"删除.

3. CTRL+END,CTRL+A,全选后按下F8,单击最后第二个段落结束位置,相当于选定了整个"表格"位置,而不包含文档结束标记.另外,当我们查找过程中有多重匹配时,应该选定文本,以使WORD可以从选定的起点处向下搜索,满足匹配精度要求. CTRL+H,勾选通配符,查找"([^t^13])([^t^13])",替换为"\10\2",全部替换二次.

说明:在表格转换为文字中,需要在^13^t(第一列第一个空白单元格)中间插入0,^t^13(最后一列的最后一个单元格)中间插入0,在中间单元格(^t^t)之间插入0,由于^13^13的肯定不存在(已在步骤3中排除,),因此"([^t^13])([^t^13])"的四个组合形式高度满足我们的查找要求.

6. CTRL+A,全选,CTRL+H,查找:" (*^13*^13*^13)(*^13)",替换为"\1\2",全部替换,可将逢四行前加上"".

7. 查找"(*^13)",替换为"\1",替换为粗体格式(CTRL+B),全部替换.

8. 查找"^13",替换为"^p",注意,不限定格式,不勾选通配符.全部替换.(WORD XP中可能需要此步骤)

9. CTRL+END,CTRL+A,全选后按下F8,单击最后第二个段落结束位置,CTRL+C复制.回到原文档中,(初时已选定表格),粘贴.如果是XP,可能已无需进行表格设置;2003,需要设置段落居中和表格线.

10. 将光标定于首行A后面,查找下一处,CTRL+SHIFT+END,BACKSPACE删除多余的表格即可(实际上是制表位自动适应表格列宽).


[此贴子已经被apolloh于2006-1-1 20:53:11编辑过]
单选投票, 共有 7 人参与投票

距结束还有: 3073 天16 小时53 分钟

您所在的用户组没有投票权限

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2005-12-5 00:42 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
晚上才看到,已经用VBA完成了,怎么上交?是直接贴代码,还是把代码复制到文本文件并加密压缩上传?

TA的精华主题

TA的得分主题

发表于 2005-12-5 00:43 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

用VBA实现的代码如下:

Option Explicit
Option Base 1
Sub test()
Dim i%, j%, k%
Dim mR As Range
Dim myRow As Row
Dim colWidth As Variant
Application.ScreenUpdating = False
With ActiveDocument.Tables(1)
For i = .Rows.Count To 2 Step -1
k = 0
For j = 1 To .Columns.Count
Set mR = .Cell(i, j).Range
If mR.Start = mR.End - 1 Then
k = k + 1
mR.Text = "0"
End If
Next
If k = .Columns.Count Then .Rows(i).Delete
Next
k = 0
For Each myRow In .Rows
k = k + 1
If k Mod 4 = 0 Then myRow.Range.Font.Bold = True
Next
colWidth = Array(2, 1.5, 2.5, 2.5, 1.5, 1, 1.5, 2, 1.5, 4)
For i = 1 To .Columns.Count
.Columns(i).Width = CentimetersToPoints(colWidth(i))
Next
End With
Application.ScreenUpdating = True
End Sub

TA的精华主题

TA的得分主题

发表于 2005-12-5 01:00 | 显示全部楼层

首行重复标题行,对应的属性是:

ActiveDocument.Tables(1).ApplyStyleHeadingRows = True

因本题目中的表格本身就是“首行重复标题行”,在VBA代码执行的过程并未改变该属性,因此就没有加入这行代码。

TA的精华主题

TA的得分主题

发表于 2005-12-5 18:33 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

晚上花了一些时间研究,不用VBA的方法,操作步骤如下:

1、表格转换为文字,选中制表符
2、找:([^13^t])([^13^t]),替换为:\10\2,勾选通配符,连续替换2次
3、找:(0^t){9}0^13,替换为:空,勾选通配符
4、全选文本,转换为表格,勾选制表符
5、表格转换为文本,勾选段落标记
6、全选文本,转换为表格,列数选40
7、选中表格的1-10列,文字格式加粗
8、表格转换为文本,勾选制表符
9、文本转换为表格,列数选10
10、选中表格第1行,点菜单“表格/标题行重复”
11、全选表格,“表格属性/列”选项卡中,指定各列的列宽分别为2,1.5,2.5,2.5,1.5,1,1.5,2,1.5,4厘米。“表格属性/单元格”选项卡中点选“居中”。

************************************

第6步列数选40后有些问题。

[此贴子已经被守柔于2005-12-23 5:06:03编辑过]

TA的精华主题

TA的得分主题

发表于 2005-12-7 13:56 | 显示全部楼层

PRINCE

Sub Prince()
Dim mCW '列宽数组
Dim mRows As Rows '行集合变量
Dim mRow As Row '行变量
Dim mCell As Cell '单元格变量
Dim x As Integer '行数计数标志
Dim mSU As Boolean, mAS As Boolean '环境变量
Dim mTime
mTime = Timer
mSU = Application.ScreenUpdating
mAS = Application.DisplayStatusBar
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.StatusBar = "正在处理..."
'表格的列宽分别为2,1.5,2.5,2.5,1.5,1,1.5,2,1.5,4厘米,首行重复标题行。
mCW = Array(2, 1.5, 2.5, 2.5, 1.5, 1, 1.5, 2, 1.5, 4)
With ThisDocument.Tables(1).Columns
For x = 0 To 9
.Item(x + 1).Width = CentimetersToPoints(mCW(x))
Next
End With
Set mRows = ThisDocument.Tables(1).Rows
mRows(1).HeadingFormat = True
x = 0
For Each mRow In mRows
With mRow
x = x + 1
If x Mod 4 = 1 Then .Range.Font.Bold = True
DoEvents
If Len(.Range.Text) = 22 Then
.Delete
x = x - 1
Else
For Each mCell In .Cells
With mCell.Range
If Len(.Text) = 2 Then
.Text = "0"
End If
End With
Next
End If
End With
Next
MsgBox "本次程序执行共耗时" & Timer - mTime & "秒!"
Application.ScreenUpdating = mSU
Application.DisplayStatusBar = mAS
End Sub

TA的精华主题

TA的得分主题

发表于 2005-12-9 19:45 | 显示全部楼层

我的答案,请批评指点:

一、查找与替换法:

1、选中表格,表格/转换/表格转换为文本,文字分隔符“制表符”;

2、查找:“^t{9}^13”,替换为啊蔽蓿?囱⊥ㄅ浞???浚徊檎遥骸?[^t^13])([^t^13])”“\10\2” 勾选通配符,全部,执行2次。把再后的几个0^13删除。

3、全选,表格/转换/文本转换为表格,选10列,制表符

4、在第一列的前面加一列,在第一行至第5行,分别输入“二、二、二、三”。复制“二、二、二、三”,再选中第一列,粘贴。选中表格,表格/转换/表格转换为文本,文字分隔符“制表符”

5、查找“三*(^13)”“”(无)格式字体\加粗,勾选通配符,全部

6、按住alt框选“二 ”即“二制表符”、“三制表符”,按Delete

7、全选,表格/转换/文本转换为表格,选10列,制表符。

8、定义表格的列宽分别为2,1.5,2.5,2.5,1.5,1,1.5,2,1.5,4厘米,首行重复标题行

二、简化的查找与替换法:

1、选中表格,表格/转换/表格转换为文本,文字分隔符“制表符”;

2、查找:“^t{9}^13”,替换为“”无,勾选通配符,全部;查找:“([^t^13])([^t^13])”“\10\2” 勾选通配符,全部,执行2次。把再后的几个0^13删除。

3、全选,字体设为红,查找:“^13*^13*^13(*^13)”,勾选通配符,勾选“突出显示所有在该范围内的项目”,查找全部,关闭,把选中的部分字体设为黑色;再手工把第一行设为黑色。

4、全选,表格/转换/文本转换为表格,选10列,制表符。

5、定义表格的列宽分别为2,1.5,2.5,2.5,1.5,1,1.5,2,1.5,4厘米,首行重复标题行.

三、变化的查找与替换法:

1、选中表格,表格/转换/表格转换为文本,文字分隔符“制表符”;

2、查找:“^t{9}^13”,替换为“”无,勾选通配符,全部;查找:“([^t^13])([^t^13])”“\10\2” 勾选通配符,全部,执行2次。把再后的几个0^13删除。

3、全选,表格/转换/文本转换为表格,选分隔符为段落标记,4列。把第4列的字体设为红色;再全选表格/转换/表格转换为文本,选文字分隔符为“段落标记”。

4、全选,表格/转换/文本转换为表格,文字分隔符为“制表符”,选10列。

5、定义表格的列宽分别为2,1.5,2.5,2.5,1.5,1,1.5,2,1.5,4厘米,首行重复标题行。

四、再变化的查找与替换法:

1、全选表格,格式/项目符号和编号/项目符号/自定义/字符,选择"0",即可,查找“^?”(当然[0-9,A-J]也行),在格式/项目符号和编号/项目符号,选“无”这样,就出现了形如的样子。

2、复制表格,新建(CTRl+N),编辑/选择性粘贴/无格式文本。查找“^t(^13)”,替换为“\1”,勾选通配符,全部;查找“^13[0^t^t]{1,}(^13)”,替换为“\1”,勾选通配符,全部;查找“^t^t”, 替换为“^t”,勾选通配符,全部.

3、全选,字体设为红,查找:“^13*^13*^13(*^13)”,勾选通配符,勾选“突出显示所有在该范围内的项目”,查找全部,关闭,把选中的部分字体设为黑色;再手工把第一行设为黑色。

4、全选,表格/转换/文本转换为表格,选10列,制表符。

5、定义表格的列宽分别为2,1.5,2.5,2.5,1.5,1,1.5,2,1.5,4厘米,首行重复标题行.

VBA方法:

Sub konggs()

Dim atable As Table, arow As Row, acell As Cell, a%

Dim arr(), n%

On Error Resume Next '忽略错误

Application.ScreenUpdating = False '关闭屏幕更新

Debug.Print Timer

For Each atable In ActiveDocument.Tables

With atable

a = atable.Columns.Count ' 表格的列数

For Each arow In .Rows

If Len(.Range) = a * 2 + 2 Then '全部为空则删除

arow.Delete

End If

If (arow.Index) Mod 4 = 0 Then '满足条件即第4行即字体加粗

arow.Range.Font.Bold = True

End If

Next

For Each acell In .Range.Cells '全部为空则为0

If Len(acell.Range) = 2 Then

acell.Range = "0"

End If

Next

'以下为定义宽度部分,不过老大的本来就是这几个值?为何?

' arr = Array("2", "1.5", "2.5", "2.5", "1.5", "1", "1.5", "2", "1.5", "4") '定义数组

' For n = 0 To UBound(arr) '在数组中循环

' atable.Columns(n + 1).PreferredWidth = CentimetersToPoints(arr(n))

' Next

End With

Next

Application.ScreenUpdating = True '开启屏幕更新

Debug.Print Timer

End Sub

***************************************

KONGGS:

你的方法很好很全面,但有些地方表述得不够精确。建议能不用通配符时,不要使用通配符,比如"^t^t"替换为"^t";"^t(^13)"(^t^p),替换为"^p",完全可以在非通配符状态下查找与替换.

另外:"^13*^13*^13(*^13)",你只需要查找,并不要求返回值时,不需要使用括号.并且整个过程你可以复核一下,查找::从头查找全部"^13*^13*^13(*^13)",应该是不选中第一、第五等等的段落文本(但选定段落标记),所以应该在查找全部之前全选文档,把文字加粗,查找符合的实例后,设置为非加粗。(也可以在替换中设置)

项目符号的方法很好。

注意表格列宽可以直接在制表位情况下复制覆盖原表格,所以我把列宽给描述出来,就是考虑希望大家不要总是把眼光放在文字转换为表格再调整列宽的方法上.

If Len(.Range) = a * 2 + 2 Then '全部为空则删除写得很规范。

注意要求是加粗而非红色.

[此贴子已经被守柔于2005-12-23 5:46:12编辑过]

TA的精华主题

TA的得分主题

发表于 2005-12-11 09:54 | 显示全部楼层

先把用VBA的方法上传:

Sub word6()
Dim myrow As Row, mycolumn As Integer
Dim mycell As Cell
Dim CEllNum As Integer
Dim Delnum As Integer
Application.ScreenUpdating = False
For Each myrow In Me.Tables(1).Rows
Me.UndoClear
If myrow.Range.End - myrow.Range.Start > 11 Then
For Each mycell In myrow.Cells
If mycell.Range.End - mycell.Range.Start = 1 Then mycell.Range.Text = 0
Next
boldnum = boldnum + 1
If boldnum Mod 4 = 0 Then myrow.Range.Bold = True
Else
myrow.Delete
End If
Next
columnArray = Array(2, 1.5, 2.5, 2.5, 1.5, 1, 1.5, 2, 1.5, 4, 2)
For mycolumn = 1 To Me.Tables(1).Columns.Count
Me.Tables(1).Columns.PreferredWidthType = wdPreferredWidthPoints
Me.Tables(1).Columns(mycolumn).PreferredWidth = CentimetersToPoints(columnArray(mycolumn))
Next
If Me.Tables(1).Rows(1).HeadingFormat = 0 Then Me.Tables(1).Rows(1).HeadingFormat=True
Application.ScreenUpdating = True
End Sub


[此贴子已经被守柔于2005-12-23 5:50:50编辑过]

TA的精华主题

TA的得分主题

发表于 2005-12-11 10:01 | 显示全部楼层

第二种方法:查找替换法

第一步:以制表符为分隔符将表格转换为文本。

第二步:查找替换

查找文字

替换为

备注

1

^13^9^9^9^9^9^9^9^9^9^13

^13

2

^13^9

^p0^9

3

^9^9

^t0^9

重复查找一次

4

^9^13

^t0^9

5

([A-Z,0-9])^13

\1^9

第三步:CTRL+END定位到表格末尾,退格删除最后一个制表符,CTRL+SHIFT+HOME

选中全部文本转换为列数为10列的表格。

第四步:设置每隔4行的文字为加粗

A. 在表格第一列前添加一列,在添加列的1234单元格分别输入“时”、“时”、“时”、“临”,选中第一到第四单元格复制,选中第一列粘贴。在表格最后列后添加一列,在添加列的第一个单元格输入“时”并选中第一单元格复制,选中最后一列粘贴。

B. 将表格转换为文本。查找“临*时”,替换为格式字体加粗。

C. 将文本转换为列数为12列表格。删除第一和最后一列。

第五步:设置表格的列宽分别为2,1.5,2.5,2.5,1.5,1,1.5,2,1.5,4厘米,首行重复标题行。

TA的精华主题

TA的得分主题

发表于 2005-12-14 11:46 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册


Option Explicit
Sub word6()
Application.ScreenUpdating = False

Dim rowsno As Integer
Dim colsno As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim blankrow As Boolean

With ThisDocument.Tables(1)

.Rows(1).HeadingFormat = False '取消标题行重复
rowsno = .Rows.Count
colsno = .Columns.Count
For i = rowsno To 1 Step -1

blankrow = True

For j = 1 To colsno
If .Cell(i, j).Range.Text <> Chr(13) & Chr(7) Then blankrow = False: GoTo setzero
Next j

If blankrow Then .Rows(i).Delete '如果为空白行,删除该行

setzero:
For k = 1 To colsno
If .Cell(i, k).Range.Text = Chr(13) & Chr(7) Then .Cell(i, k).Range.Text = 0 '如果不为空白行,该行中的空白格填上0
Next k

Next i

rowsno = .Rows.Count

For i = 1 To rowsno
If i Mod 4 = 0 Then .Rows(i).Range.Font.Bold = True '行数是4的倍数的字体加粗
Next i

.Rows(1).HeadingFormat = True '标题行重复

'设置列宽
Dim colwid
colwid = Split("2,1.5,2.5,2.5,1.5,1,1.5,2,1.5,4", ",")
For j = 0 To UBound(colwid)
.Columns(j + 1).Width = CentimetersToPoints(Val(colwid(j)))
Next

End With
Application.ScreenUpdating = True
End Sub
1.全选表格,转换为文本,分隔符为制表符。
2.CTRL+H 选通配符,查找 (^t){9}^13 替换为空白
3.CTRL+H 选通配符,查找 ^t^t替换为^t0^t
4.CTRL+H 选通配符,查找 ^t^13替换为^t0^p
5.CTRL+H 选通配符,查找 ^13^t替换为^p0^t
6.CTRL+H 选通配符,查找 ^13[0-z,^t]@^13[0-z,^t]@^13[0-z,^t]@^13 替换为 ^&^p
7.CTRL+H 选通配符,查找 ^13[0-z,^t]@^13^13 替换为 ^& [加粗]
8.全选文本,文本转换为表格,10列,文字分隔位置为制表符
9.选择表格首行,选标题行重复。
10.表格属性中调整各列列宽分别为2,1.5,2.5,2.5,1.5,1,1.5,2,1.5,4(厘米)。

[此贴子已经被守柔于2005-12-23 5:54:34编辑过]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

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

本版积分规则

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

GMT+8, 2024-11-16 20:24 , Processed in 0.057742 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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