青岛户籍政策2017新政:vb 文本处理示例(2)

'我插入的没有空格啊,你是怎么插入的? 要不你把你插入"2"的地方换成Trim("2")试试看

Private Sub Form_Click()
    Dim a As String, b As String
    a = "111111111111"
    For i = 1 To Len(a) Step 3
        b = b & Mid(a, i, 3) & "2"
    Next
    Print b
End Sub ************************************************************************快速查找或替换文本中的字符 查找给定文本中的匹配字符算得上是一个很古老编程话题。以前有很多关于这方面的文章。不过本文所讲的方法应该说是一个很新的方法，至少站长我以前没见过(别笑我孤陋寡闻)。这个方法其实很简单，只须几行语句就行了。不过你必需安装了Window Script5.1，具体获得该程序的方法见本站另一篇文章：检查电子邮件地址的有效性。

首先在窗体上添加一个文本框和一个命令按钮，下面是代码清单：

Option Explicit
Dim MyReg As RegExp
Dim temp As MatchCollection

Private Sub Command1_Click()
    Set MyReg = New RegExp
    MyReg.IgnoreCase = True
    MyReg.Global = True
    MyReg.Pattern = "newvb"
    Set temp = MyReg.Execute(Text1.Text)
    Label1.Caption = temp.Count
    Dim i As Integer
    For i = 0 To temp.Count - 1
        Debug.Print temp.Item(i)
    Next
End Sub
上面的程序使你能查找文本框中包含newvb的字符串，并将结果在立即窗口中显示出来。如果你想替换文本，只须用RegExp对象的replace方法即可。******************************************************************************

TextBox 是以 vbCr+vbLf 为分行符号， 如果我们要逐一读取 TextBox 每一行，无非是寻找 vbCr+vbLf 的所在位置， 然后取出每一行的字串， 不过这个方法真的不快，而且如果我们要读取第 N 行资料， 还是要从第 1、2、┅N-1 行逐一读起， 实在麻烦。还好 Windows API 提供有读取 TextBox 第 N 行的功能， 细节如下：1. API 的声明：Const EM_GETLINE = &HC4Const EM_LINELENGTH = &HC1Const EM_LINEINDEX = &HBBPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam AsAny) As LongPrivate Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any,lpvSource As Any, ByVal cbCopy As Long)注：如果以上的声明放在「一般模块」底下， 应在 Const 之前加上 Public 保留字， 并且将 Private 保留字去掉。2. 程序范例：Sub TB_GetLine(ByVal hWnd As Long, ByVal whichLine As Long, Line AsString)Dim length As Long, bArr() As Byte, bArr2() As Byte, lc As Longlc = SendMessage(hWnd, EM_LINEINDEX, whichLine, ByVal 0&)length = SendMessage(hWnd, EM_LINELENGTH, lc, ByVal 0&)If length > 0 ThenReDim bArr(length + 1) As Byte, bArr2(length - 1) As ByteCall RtlMoveMemory(bArr(0), length, 2)Call SendMessage(hWnd, EM_GETLINE, whichLine, bArr(0))Call RtlMoveMemory(bArr2(0), bArr(0), length)Line = StrConv(bArr2, vbUnicode)ElseLine = ""End IfEnd Sub' 假设要读取 Text1 第 5 行的资料Dim S As StringCall TB_GetLine( Text1.hWnd, 5, S )' 传回值 S 即等于到 5 行的资料注：TextBox 的行次是从 0 起算。

*********************************************************************'查找替换
 Option Explicit Private Sub Command1_Click() Call ReplaceInFile("C:\test.txt", "x", "10000") End Sub

Private Sub ReplaceInFile(FileName As String, ReplaceStr As String, ReplaceWithStr As String) Dim FileNum As Long, strFileContent As String, strTemp As String

FileNum = FreeFile
If Dir(FileName) <> "" Then Open FileName For Input As #FileNum While Not EOF(FileNum) Line Input #FileNum, strTemp strFileContent = strFileContent & strTemp & vbCrLf Wend Close #FileNum strFileContent = Replace(strFileContent, ReplaceStr, ReplaceWithStr, , , vbDatabaseCompare) Open FileName For Output As #FileNum Print #FileNum, strFileContent Close #FileNum End If End Sub******************************************************************将查找的内容复制到另一文本框内 Private Sub CommandButton8_Click()Dim i%, m%, current As String, now As String, filestyle As StringDim Wdapp As Word.ApplicationDim WdDocument As Word.DocumentDim UserFile As StringSet Wdapp = New Word.ApplicationUserFile = Wdapp.Path & "\jmxq-1.doc"Set WdDocument = Wdapp.Documents.Open("C:\SOFT\example pool\jmxq-1.doc")Wdapp.Visible = TrueFor m = 2 To 30current = "<" & Sheet10.Cells(m, 1) & ">"now = Sheet10.Cells(m, 2)Wdapp.Selection.Find.Execute Replace:=wdReplaceAll    With Wdapp.Selection.Find        .Text = current        .Replacement.Text = now        .Forward = True        .Wrap = wdFindContinue        .Format = True        .MatchCase = False        .MatchWholeWord = False        .MatchByte = True        .MatchWildcards = False        .MatchSoundsLike = False        .MatchAllWordForms = False    End With    Wdapp.Selection.Find.Execute Replace:=wdReplaceAll    CommandBars("Exit Design Mode").Visible = FalseNext mEnd Sub这个是我写的在WORD里面根据一个EXCEL表查找替换内容的 希望对你有用