用VBA能够进行这种棋谱转换吗？

yujunrui

转换内容：
1、标题、主变内容不动
2、后面的变着部分去掉空行、着法之间用逗号、去掉全部空格、注解内容用括号、每个变着的行合并成一个段落。

用正则表达式替换应该可以，但有选择的替换没有思路，请高手指导。

下面是示例文件
pack.rar (17.93 KB, 下载次数: 24)

2015-1-9 14:11 上传

点击文件名下载附件

yujunrui

不见高人出手，我自己目前的解决方案：
1、在最后位置添加文字“标题”，然后用查找功能选择需要转换的内容。
2、用宏完成替换操作。

csnAlex

没有使用正则表达式，纯粹用字符比较。这样可以不用引用更多的库。
思路容易，细节比较繁琐。代码就懒得注释了。

1. Sub 格式转换()
   
2. '
   
3. ' 宏在 2015/1/16 Friday 由 刘小军(csnAlex-ExcelHome.net) 编写
   
4. '
   
5.     Dim s As String, i As Integer, j As Integer, k As Integer, st As String, mr As Range
   
6.     Dim ss As String, sline() As String
   
7.     Dim ErrChar() As Variant, oChar As Variant
   
8.     ErrChar = Array(".", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", " ", "…")
   
9. 
   
10.     ActiveDocument.Paragraphs.Last.Range.InsertBefore " " & Chr(13)
    
11.     ActiveDocument.Range(0, 0).Select
    
12.     Do Until Selection.End = ActiveDocument.Paragraphs.Last.Range.Start
    
13.         s = Selection.Paragraphs(1).Range.Text
    
14.         Select Case Left(s, 2)
    
15.             Case "标题"
    
16.                 If i = 1 Then Selection.InsertBefore " " & Chr(13)
    
17.                 i = 0
    
18.             Case "[变"
    
19.                 i = 1
    
20.                 Set mr = Selection.Paragraphs(1).Range
    
21.             Case " " & Chr(13)
    
22.                 If i = 1 Then
    
23.                     mr.End = Selection.Start + 1
    
24.                     st = mr.Text
    
25.                     sline() = Split(st, Chr(13))
    
26.                     j = UBound(sline) - 1
    
27.                     k = InStr(1, sline(0), "接主变")
    
28.                     If k > 0 Then
    
29.                         ss = "【注" & Mid(sline(0), k - 1, 1) & "←主变】如"
    
30.                     Else
    
31.                         k = InStr(1, sline(0), "接")
    
32.                         ss = "【注" & Mid(sline(0), k - 1, 1) & "←注" & Mid(sline(0), k + 1, 1) & "】如"
    
33.                     End If
    
34.                     For k = 1 To j
    
35.                         st = Trim(sline(k))
    
36.                         If IsNumeric(Left(st, 1)) Then
    
37.                             If k > 1 Then ss = ss & "，"
    
38.                             st = Replace(st, "    ", "，")
    
39.                             For Each oChar In ErrChar    '进行一系列替换,即删除无效字符
    
40.                                 st = Replace(st, oChar, "")
    
41.                             Next
    
42.                             ss = ss & st
    
43.                         Else
    
44.                             ss = ss & "（" & st & "）"
    
45.                         End If
    
46.                     Next
    
47.                     mr.Text = ss
    
48.                 End If
    
49.         End Select
    
50.         
    
51.         Selection.MoveDown wdParagraph, 1
    
52.     Loop
    
53.    
    
54.     MsgBox "处理完毕，建议另存文件。", vbInformation + vbOKOnly, "Code By csnAlex-ExcelHome.Net"
    
55.    
    
56. End Sub
    

复制代码

yujunrui

谢谢楼上大侠，运行成功，待我慢慢研究学习。