[已解决]将word个人信息表汇总到EXCEL表

dyzx

请各位老师帮忙将word个人信息表汇总到EXCEL表，代码应该怎样写，请指教，多谢。

最佳答案

月排行榜 / 总排行榜

爱疯

2017-1-8 17:13

Sub test()
    Dim p As String, f As String
    Dim A(1 To 1000, 1 To 6) As String
    Dim i As Integer

    Application.ScreenUpdating = False
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.doc")

    Do While f <> ""
        With GetObject(p & f).Tables(1)
            i = i + 1
            A(i, 1) = delChar(.cell(2, 2))
            A(i, 2) = delChar(.cell(3, 2))
            A(i, 3) = delChar(.cell(8, 2))
            A(i, 4) = delChar(.cell(8, 4))
            A(i, 5) = delChar(.cell(12, 4))
            A(i, 6) = getIP(.cell(17, 2))
        End With
        f = Dir()
    Loop

    Range("a1").CurrentRegion.Offset(1, 0).ClearContents
    [A2].Resize(i, UBound(A, 2)) = A
End Sub

'删除多余的字符
Function delChar(x As String) As String
    delChar = Left(x, Len(x) - 1)
End Function

'获取IP和掩码
Function getIP(str As String) As String
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "(\d+\.){3}\d+"
        If .Execute(str).Count Then getIP = .Execute(str)(0) & "/" & .Execute(str)(1)
    End With
End Function

2.rar (36.96 KB, 下载次数: 26)

2017-1-8 17:13 上传

点击文件名下载附件





这是以前我的一个求助贴。

从WORD中提取内容到EXCEL
http://www.excelpx.com/thread-208934-1-1.html

跳转到最佳答案楼层

爱疯

Sub test()
    Dim p As String, f As String
    Dim A(1 To 1000, 1 To 6) As String
    Dim i As Integer

    Application.ScreenUpdating = False
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.doc")

    Do While f <> ""
        With GetObject(p & f).Tables(1)
            i = i + 1
            A(i, 1) = delChar(.cell(2, 2))
            A(i, 2) = delChar(.cell(3, 2))
            A(i, 3) = delChar(.cell(8, 2))
            A(i, 4) = delChar(.cell(8, 4))
            A(i, 5) = delChar(.cell(12, 4))
            A(i, 6) = getIP(.cell(17, 2))
        End With
        f = Dir()
    Loop

    Range("a1").CurrentRegion.Offset(1, 0).ClearContents
    [A2].Resize(i, UBound(A, 2)) = A
End Sub

'删除多余的字符
Function delChar(x As String) As String
    delChar = Left(x, Len(x) - 1)
End Function

'获取IP和掩码
Function getIP(str As String) As String
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "(\d+\.){3}\d+"
        If .Execute(str).Count Then getIP = .Execute(str)(0) & "/" & .Execute(str)(1)
    End With
End Function

2.rar (36.96 KB, 下载次数: 26)

2017-1-8 17:13 上传

点击文件名下载附件





这是以前我的一个求助贴。

从WORD中提取内容到EXCEL
http://www.excelpx.com/thread-208934-1-1.html

dyzx

爱疯 发表于 2017-1-8 17:13
Sub test()
    Dim p As String, f As String
    Dim A(1 To 1000, 1 To 6) As String

爱疯老师：如果我要增加一列“用户类型”，但其中有“五个选项”，应该怎样修改代码，多谢指教。

爱疯

dyzx 发表于 2017-1-8 19:12
爱疯老师：如果我要增加一列“用户类型”，但其中有“五个选项”，应该怎样修改代码，多谢指 ...

我不大理解3楼的含义。


最好，你手动添加一列，并提供结果。再看能否看懂

dyzx

爱疯 发表于 2017-1-8 19:23
我不大理解3楼的含义。

爱疯老师：如果我要增加一列“用户类型”，但其中有“五个选项”，应该怎样修改代码，多谢指 ...

苏子龙

怎么提问提到一样的内容去了？

dyzx

爱疯 发表于 2017-1-8 17:13
Sub test()
    Dim p As String, f As String
    Dim A(1 To 1000, 1 To 6) As String

爱疯老师：为什么将你的代码用于其他表格不可用，请指教，多谢。

dyzx

爱疯 发表于 2017-1-8 17:13
Sub test()
    Dim p As String, f As String
    Dim A(1 To 1000, 1 To 6) As String

爱疯老师：多谢你的帮助，多谢。但如果我将个人信息表放入一个文件夹里，应该怎样修改代码，多谢指教。