同字符按列排列改成按行排列

52excel

JfM0xPLi.rar (4.86 KB, 下载次数: 12)

2006-1-20 12:21 上传

点击文件名下载附件
同字符按列排列改成按行排列

案 案 案 案 案 案 案 案 案 把 把 边 表 表 部 查 查 次 挡 档 档 到 到 到 的 第 第 定 方 方 方 方 方 方 方 方 方 方 方 方 方 放 放 该 变成: 案案案案案案案案案9 把把2 边1 表表2 部1 查查2 次1 挡档档3 到到到4 的5 第第2 定1 方方方方方方方方方方方方方13 放放2 该1 怎么办？？？

c81

思路：

先将所有的回车即段落符去掉，然后将任意只要是不同字之间加上一个段落回车，再将每个字后面加上一个制表符，然后再将它们变成表格，最右边加上一列，用Word的表统计计数一下即可。注意批量填充计数的域代码。

其实后几步送到Excel中可能要方便些。

52excel

然后将任意只要是不同字之间加上一个段落回车， ——————关键是这一步，不知道怎么办，还请高手赐教！

konggs

试试这个宏：

Sub 孤独二叶()
Dim a%, b%, apa As Paragraph
On Error Resume Next
b = ActiveDocument.Characters.Count

With ActiveDocument.Content.Find
.Execute FindText:="^p", ReplaceWith:="", Replace:=wdReplaceAll
End With
For a = 1 To b
If ActiveDocument.Characters(a) = ActiveDocument.Characters(a + 1) _
And ActiveDocument.Characters(a) <> Chr(13) And ActiveDocument.Characters(a + 1) <> Chr(13) Then

Else
ActiveDocument.Characters(a).Font.Color = wdColorBlue
End If
Next
With ActiveDocument.Content.Find
.ClearFormatting '清除格式设置
.MatchWildcards = True
.Font.Color = wdColorBlue
With .Replacement '替换条件
.ClearFormatting '清除格式设置
.Font.Color = wdColorBlack
End With
.Execute FindText:="([!一])", ReplaceWith:="\1^p", Format:=True, _
Replace:=wdReplaceAll '是格式替换,全部替换
End With
For Each apa In ActiveDocument.Paragraphs
apa.Range.Characters(Len(apa.Range.Text) - 1).InsertAfter Len(apa.Range.Text) - 1
Next
End Sub

守柔

我也试着做了一个，请楼主测试一下 Option Explicit Sub Example() Dim i As Range, acharCount As Integer, myRange As Range On Error GoTo E Application.ScreenUpdating = False With ActiveDocument With .Content.Find .Execute FindText:="^p", ReplaceWith:="", Replace:=wdReplaceAll End With Set myRange = .Content Again: acharCount = 1 For Each i In myRange.Characters If i.Next.Text = i.Text Then acharCount = acharCount + 1 Else i.InsertAfter acharCount & Chr(13) Set myRange = .Range(i.Next(2).Start, .Content.End) GoTo Again End If Next End With E: Application.ScreenUpdating = True End Sub

[此贴子已经被作者于2006-1-20 17:12:07编辑过]

konggs

老大的利害，[em17][em17]

请教：Range(i.Next(2).Start，

中的2是什么意思？

当初，当快想到这这个方法（在Characters
中循环），但一开始开始定值的话，与后来的动值就不对了，所就卡住了，改成现在这个很笨的方法。

老大，利用这个反复缩小（也在改变）范围的方法真是不错，但记得哪位版主说：（excel开发版的）结构化编程是不用goto的？

52excel

谢谢诸位![em17][em17][em17]

慢慢学习.

老大最简洁!

52excel

俺也琢磨了一个,但是不能完成频率统计.请指教.

sub初学()

Selection.HomeKey Unit:=wdStory '光标回到最开始

Dim a As String, b As String

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend

Selection.Copy

a = Selection.text

Selection.MoveRight Unit:=wdCharacter, Count:=1

Do

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend

Selection.Copy

b = Selection.text

If a <> b Then

' Selection.MoveRight Unit:=wdCharacter, Count:=1

' Selection.TypeParagraph

' Else

Selection.MoveLeft Unit:=wdCharacter, Count:=1

Selection.TypeParagraph ' 插入回车符

Else

Selection.MoveRight Unit:=wdCharacter, Count:=1

End If

a = b

Loop Until b = "停" '调处循环的设置很笨,是人为在最后加一个字,请修改

end sub()

守柔

TO KONGGS，你翻一下帮助文件吧，比我说得更好一些。另请加强对RANGE对象深入理解。

我做了一个夹生的，希望对大家有所启迪：

先查找："^p",替换为""(无),全部替换,即删除所有段落标记

再CTRL+A,CTRL+H,勾选通配符

查找:"([一-龥])@",替换为"^&^p",全部替换.

运行以下宏:

Option Explicit
Sub Sample()
Dim i As Paragraph, myRange As Range
Application.ScreenUpdating = False
For Each i In ActiveDocument.Paragraphs
Set myRange = i.Range
With myRange
.SetRange .Start, .End - 1
If .Text <> "" Then
.InsertAfter Text:=.End - .Start
End If
End With
Next
Application.ScreenUpdating = True
End Sub
当然,我们完全可以将查找与替换融入这个代码中,我就不写了.

52excel

感谢守柔,虽不全懂,但看得很有味道!