如何自动删除表格中有的多个回车符？成为一行。

liez9276

使用效果很不错，谢谢！

守柔

几个情况说明：

一：WORD中的表格，类似于你这样的情况，应该这样进行，将头（花名册、年月日）尾（填表人）置于页眉页脚中，将表格的首行重复标题行（表格/重复标题行），这样，一个表格就可以解决问题。（无论几页，自动产生重复表头，操作方法，选定需要重复的表头，再表格/重复标题行）

二：此文档进入EXCEL，以你这样的设计，意义不大，应该使用固定表头，每个新单项为一列，尽量不要合并单元格。当需要打印时，可以设置打印标题行（页面设置中），固定的表头可以窗口/冻结窗口，便于查阅。适当使用页眉页脚，使之相同的内容或者重复的内容进入页眉页脚中（如花名册，年月日），页脚中写入填表人：***。

三：不同类型表格，置于不同的工作表中。

四：关于自动写入EXCEL中的代码，首先，可以不用复制粘贴的方法，但你是否保证你所传的附件中的WORD文档，每个表格中的相同部分所占的单元格行数相同，另外在表格中没有合并单元格？如果是这样，可以将WORD中的数据直接写入EXCEL中，但我想进行空白的EXCEL工作表中，你以后再进行EXCEL表头的设置。

先说到这里，你看看吧！

xxs1025

我本人对excel 的基本操作也是比较好的，对word的基本操作也可以，但是那个word的表格不是出自一个人的手，水平也不可能象版主那么高。但表格形式的完全一样的。我又思考了一个。我其实只需要把文本自动转换成相关表格就可以了。然后再在excel中慢慢调整好了。

守柔

你的文本在哪里，附件中好象未曾见到。如果要转换，可以使用表格/文本转换为表格即可

xxs1025

文本就是word中的表头，如果自动完成转换表格而且与下面的表格粘成一个表格就好了。这样到了excel中就不用调整了。谢谢！

守柔

这样，你先在上传的附件中运行此宏，看一下效果如何：

Sub TEST() Dim i As Integer, W1 As Double, W2 As Double, W3 As Double, W4 As Double On Error Resume Next Application.ScreenUpdating = False For i = 1 To 18 w = Me.Tables(1).Cell(3, i).Width If i <= 4 Then W1 = W1 + w ElseIf i <= 8 Then W2 = W2 + w ElseIf i <= 12 Then W3 = W3 + w ElseIf i <= 18 Then W4 = W4 + w End If Next With ActiveDocument .Paragraphs(2).Range.ConvertToTable Separator:=wdSeparateByTabs With .Tables(1) .Style = "Íø¸ñÐÍ" .Cell(1, 1).Width = W1 .Cell(1, 2).Width = W2 .Cell(1, 3).Width = W3 .Cell(1, 4).Width = W4 End With .Paragraphs(1).Range.ConvertToTable .Tables(1).Cell(1, 1).Width = W1 + W2 + W3 + W4 End With Application.ScreenUpdating = True End Sub

守柔

修改了一下，改为以下代码：

Sub TEST() Dim i As Integer, W1 As Double, W2 As Double, W3 As Double, W4 As Double Dim MyRange As Range On Error Resume Next Application.ScreenUpdating = False With ActiveDocument Tb = .Tables(1).Columns.Width For i = 1 To 18 w = .Tables(1).Cell(3, i).Width If i <= 4 Then W1 = W1 + w ElseIf i <= 8 Then W2 = W2 + w ElseIf i <= 12 Then W3 = W3 + w ElseIf i <= 18 Then W4 = W4 + w End If Next Set MyRange = .Range(.Paragraphs(1).Range.Start, .Paragraphs(2).Range.End) MyRange.ConvertToTable Separator:=wdSeparateByTabs With .Tables(1) .Style = "Íø¸ñÐÍ" For i = 1 To 2 .Cell(i, 1).Width = W1 .Cell(i, 2).Width = W2 .Cell(i, 3).Width = W3 .Cell(i, 4).Width = W4 Next .Cell(Row:=1, Column:=1).Merge _ MergeT=.Cell(Row:=1, Column:=4) .Rows.Alignment = wdAlignRowCenter End With End With Application.ScreenUpdating = True End Sub

xxs1025

当运行到时

.Style ="í???Dí"时，出现如下提示：

编译错误，数据方法或成员未找到。

第一个代码也行不通。我对word的vba可是一窍不通。对excel的vba 还有一点了解。谢谢。

xxs1025

我在实际操作当中发现,用了版主的宏之后,多行的问题解决了,但是列又有对不齐的现象,我仔细观察发现原来在某些方面word的表格当中,本身的列的线有些就没有对齐,有些看上去对起了,但一粘贴到excel当中又对不齐了.有没有办法让word 中表格的列完全自动对齐呢?谢谢!

守柔

以下是引用xxs1025在2004-10-22 21:08:00的发言：

我在实际操作当中发现,用了版主的宏之后,多行的问题解决了,但是列又有对不齐的现象,我仔细观察发现原来在某些方面word的表格当中,本身的列的线有些就没有对齐,有些看上去对起了,但一粘贴到excel当中又对不齐了.有没有办法让word 中表格的列完全自动对齐呢?谢谢!

'都是粘贴惹的祸,有时一不小心就让中文代码成了乱码,让楼主操心了.

Sub TEST()

Dim i As Integer, W1 As Double, W2 As Double, W3 As Double, W4 As Double

Dim w As Double, MyRange As Range

On Error Resume Next

Application.ScreenUpdating = False

With ActiveDocument

Tb = .Tables(1).Columns.Width

For i = 1 To 18

w = .Tables(1).Cell(3, i).Width

If i <= 4 Then

W1 = W1 + w

ElseIf i <= 8 Then

W2 = W2 + w

ElseIf i <= 12 Then

W3 = W3 + w

ElseIf i <= 18 Then

W4 = W4 + w

End If

Next

Set MyRange = .Range(.Paragraphs(1).Range.Start, .Paragraphs(2).Range.End)

MyRange.ConvertToTable Separator:=wdSeparateByTabs

With .Tables(1)

.Style = "网格型"

For i = 1 To 2

.Cell(i, 1).Width = W1

.Cell(i, 2).Width = W2

.Cell(i, 3).Width = W3

.Cell(i, 4).Width = W4

Next

.Cell(Row:=1, Column:=1).Merge _

MergeT=.Cell(Row:=1, Column:=4)

.Rows.Alignment = wdAlignRowCenter

End With

End With

Application.ScreenUpdating = True

End Sub

为了减少此事的再次发生,我编了一个小代码,与大家共享:

Sub GetCopy() Dim i As Integer, Avs As Object, strSub As String Set Avs = Application.VBE.SelectedVBComponent i = Avs.CodeModule.CountOfLines With Selection .Collapse Direction:=wdCollapseEnd For n = 1 To i strSub = Avs.CodeModule.Lines(n, 1) .InsertAfter strSub & Chr(13) Next .Cut End With End Sub

此法原理是将当前代码窗口中的代码逐行插入到当前文档中,最后剪切,然后回到论坛上粘贴.(此代码应置于NORMAL模板中,运行时点VBE中的工具/宏:如图所示:

[此贴子已经被作者于2004-10-23 8:23:17编辑过]