[求助]该宏一运行，word就假死！

byld

Option Explicit

Sub daili()
Dim i As Paragraph, x As Integer, myrange As Range, r1 As Range
x = 1
    If Application.ActiveDocument.Tables.Count < 1 Then
        MsgBox "不存在表格"
        Exit Sub
    End If
     With Application.ActiveDocument.Tables(1)
        .Columns(3).Delete
        .ConvertToText Separator:=wdSeparateByTabs
     End With
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Set myrange = Application.ActiveDocument.Range
    With myrange.Find
        .Text = "??:"
        .Replacement.Text = ":"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    myrange.Find.Execute Replace:=wdReplaceAll
    For Each i In Application.ActiveDocument.Paragraphs
        If i.Range.Find.Execute(findtext:=":80") = True Then
           
         Else
            i.Range.Delete
        End If
  
    Next
        With myrange.Find
     
        .Execute findtext:="^t", replacewith:="", Format:=False, Replace:=wdReplaceAll
   
       .Execute findtext:="HTTP", replacewith:="@HTTP#", Replace:=wdReplaceAll
      
      End With
 
End Sub

iruKfc09.rar (78.05 KB, 下载次数: 10)

2007-2-2 08:43 上传

点击文件名下载附件
[求助]该宏一运行，word就假死！

该宏的目的是将附件中的代理表格格式进行转换，转换成固定格式。

第三列为时间，没有实际意思，删去。

最后转化成如下格式

192.168.1.1：8080@HTTP#备注

.

.

.

即冒号后面是端口号，@后是协议，#后是备注

最后存为纯文本格式。
我自己做了一个代码，代理少的时候还可以将就，如附件那么多，非死不可。

大侠帮我优化一下，或者直接重写一个，谢谢！

再谢！

sylun

在大侠出手前，我趁机跟帖练习练习，一同请教。
修改了一下，勉强可完成附件的替换：
Option Explicit
Sub daili()
Dim i As Paragraph, x As Integer, myrange As Range, r1 As Range
Application.ScreenUpdating = False
x = 1 '这句不知有何用？
Set myrange = Application.ActiveDocument.Range
    If myrange.Tables.Count < 1 Then
        MsgBox "不存在表格"
        Exit Sub
    End If
     With myrange.Tables(1)
        .Columns(3).Delete
        .ConvertToText Separator:=wdSeparateByTabs
     End With
     With myrange.Find
        .ClearFormatting
        .Text = "??:"
        .Replacement.ClearFormatting
        .Replacement.Text = ":"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    myrange.Find.Execute Replace:=wdReplaceAll
    For Each i In myrange.Paragraphs
        If i.Range.Find.Execute(findtext:=":80") = False Then
           i.Range.Delete
        End If
    Next
        With myrange.Find
        .Execute findtext:="^t", replacewith:="", Format:=False, Replace:=wdReplaceAll
       .Execute findtext:="HTTP", replacewith:="@HTTP#", Replace:=wdReplaceAll
        End With
Application.ScreenUpdating = True
End Sub

[此贴子已经被作者于2007-2-2 9:42:52编辑过]

byld

二楼代码运行也不理想，等待相当长时间也没有结束，按ESC键取消后，执行结果结果满足要求（制表符没能除去）。

补充一下，要除去非80和8080的代理。

sylun

QUOTE:

以下是引用byld在2007-2-2 9:58:57的发言：

二楼代码运行也不理想，等待相当长时间也没有结束，按ESC键取消后，执行结果结果满足要求（制表符没能除去）。

补充一下，要除去非80和8080的代理。

我的机执行的时间大概10秒种，执行完后没发现有制表符，也没见有非80和8080的行。

byld

我的乖，我傻傻的等了约3分钟，才执行完毕，这效率也太差了吧？

是不是代码那边出问题了？

大侠指点一下。

我的可是P43.0的，超线程的，内存小点256兆

sylun

可能不是代码问题。
刚才我也运行了您的你代码，执行时间差不多。我的机也是p4 3.0 256内存，word2003sp2

byld

可能是我的word问题，我用的是2003，非正版的，以前运行守版主的一个得到word所有内置工具条的代码，也是一动就死，word没有响应，不像这个，等等死活还能出来。