Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2333|回复: 6

[已解决]信息汇总

[复制链接]
发表于 2017-1-10 15:04 | 显示全部楼层 |阅读模式
本帖最后由 dyzx 于 2017-1-10 16:59 编辑

附件里的代码不能正常运行,请老师们多多指教,多谢
最佳答案
2017-1-10 16:43
Sub test()
    Dim p As String, f As String
    Dim A(1 To 1000, 1 To 35) 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) = .cell(1, 1)       '不清楚对应关系
            A(i, 2) = .cell(2, 2)       '姓名
            A(i, 3) = .cell(2, 4)       '性别
            A(i, 4) = .cell(2, 6)       '出生日期
            A(i, 5) = .cell(3, 2)       '出生地
            A(i, 6) = .cell(3, 4)       '民族
            A(i, 7) = .cell(3, 6)       '政治面貌
            A(i, 8) = .cell(4, 2)       '户籍所在地
            A(i, 9) = .cell(4, 4)       '入党团日期
           A(i, 10) = .cell(1, 1)
            A(i, 11) = .cell(1, 1)
            A(i, 12) = .cell(1, 1)
            A(i, 13) = .cell(1, 1)
            A(i, 14) = .cell(1, 1)
            A(i, 15) = .cell(1, 1)
            A(i, 16) = .cell(1, 1)
            A(i, 17) = .cell(1, 1)
            A(i, 18) = .cell(1, 1)
            A(i, 19) = .cell(1, 1)
            A(i, 20) = .cell(1, 1)
            A(i, 21) = .cell(1, 1)
            A(i, 22) = .cell(1, 1)
            A(i, 23) = .cell(1, 1)
            A(i, 24) = .cell(1, 1)
            A(i, 25) = .cell(1, 1)
            A(i, 26) = .cell(1, 1)
            A(i, 27) = .cell(1, 1)
            A(i, 28) = .cell(1, 1)
            A(i, 29) = .cell(1, 1)
            A(i, 30) = .cell(1, 1)
            A(i, 31) = .cell(1, 1)
            A(i, 32) = .cell(1, 1)
            A(i, 33) = .cell(1, 1)
            A(i, 34) = .cell(1, 1)
            A(i, 35) = .cell(1, 1)
        End With
        f = Dir()
    Loop

    Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Range("j:j").NumberFormat = "@"    '因为是身份证信息
    [A2].Resize(i, UBound(A, 2)) = A
    Range("A1").CurrentRegion.Replace Chr(7), ""
End Sub



蓝色部分的.cells(1,1),请自行修改
方法:数一数WORD表行的几行几列
比如:入党团日期在EXCEL中是第9列,在WORD中是4行4列,所以改成 A(i, 9) = .cell(4, 4)

信息汇总.rar

32.43 KB, 下载次数: 8

发表于 2017-1-10 16:25 | 显示全部楼层
Sub test()
   Dim p As String, f As String
    Dim A(1 To 1000, 1 To 15) As String
    Dim i As Integer

    Application.ScreenUpdating = False
    p = ThisWorkbook.Path & "\&#184;&#246;è&#203;D&#197;&#207;¢±í\"
    f = Dir(p & "*.doc")
Set wordapp = CreateObject("Word.Application")
    Do While f <> ""
      Set wordD = wordapp.Documents.Open(p & f)
         i = i + 1
         With wordD.Tables(1)
'        With GetObject(p & f).Tables(1)
            A(i, 2) = delChar(.cell(2, 2))
            A(i, 3) = delChar(.cell(2, 4))
            A(i, 4) = delChar(.cell(2, 6))
            A(i, 5) = delChar(.cell(3, 2))
            A(i, 6) = delChar(.cell(3, 4))
            A(i, 7) = delChar(.cell(3, 6))
            A(i, 8) = delChar(.cell(4, 2))
            A(i, 9) = delChar(.cell(4, 4))
            A(i, 10) = delChar(.cell(5, 2))
            A(i, 11) = delChar(.cell(5, 4))
            
            
'            A(i, 10) = getIP(.cell(5, 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
照着做还少写了?错了?还是自己动手吧

评分

参与人数 1 +2 收起 理由
dyzx + 2

查看全部评分

回复

使用道具 举报

发表于 2017-1-10 16:43 | 显示全部楼层    本楼为最佳答案   
Sub test()
    Dim p As String, f As String
    Dim A(1 To 1000, 1 To 35) 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) = .cell(1, 1)       '不清楚对应关系
            A(i, 2) = .cell(2, 2)       '姓名
            A(i, 3) = .cell(2, 4)       '性别
            A(i, 4) = .cell(2, 6)       '出生日期
            A(i, 5) = .cell(3, 2)       '出生地
            A(i, 6) = .cell(3, 4)       '民族
            A(i, 7) = .cell(3, 6)       '政治面貌
            A(i, 8) = .cell(4, 2)       '户籍所在地
            A(i, 9) = .cell(4, 4)       '入党团日期
           A(i, 10) = .cell(1, 1)
            A(i, 11) = .cell(1, 1)
            A(i, 12) = .cell(1, 1)
            A(i, 13) = .cell(1, 1)
            A(i, 14) = .cell(1, 1)
            A(i, 15) = .cell(1, 1)
            A(i, 16) = .cell(1, 1)
            A(i, 17) = .cell(1, 1)
            A(i, 18) = .cell(1, 1)
            A(i, 19) = .cell(1, 1)
            A(i, 20) = .cell(1, 1)
            A(i, 21) = .cell(1, 1)
            A(i, 22) = .cell(1, 1)
            A(i, 23) = .cell(1, 1)
            A(i, 24) = .cell(1, 1)
            A(i, 25) = .cell(1, 1)
            A(i, 26) = .cell(1, 1)
            A(i, 27) = .cell(1, 1)
            A(i, 28) = .cell(1, 1)
            A(i, 29) = .cell(1, 1)
            A(i, 30) = .cell(1, 1)
            A(i, 31) = .cell(1, 1)
            A(i, 32) = .cell(1, 1)
            A(i, 33) = .cell(1, 1)
            A(i, 34) = .cell(1, 1)
            A(i, 35) = .cell(1, 1)
        End With
        f = Dir()
    Loop

    Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Range("j:j").NumberFormat = "@"    '因为是身份证信息
    [A2].Resize(i, UBound(A, 2)) = A
    Range("A1").CurrentRegion.Replace Chr(7), ""
End Sub



蓝色部分的.cells(1,1),请自行修改
方法:数一数WORD表行的几行几列
比如:入党团日期在EXCEL中是第9列,在WORD中是4行4列,所以改成 A(i, 9) = .cell(4, 4)

评分

参与人数 1 +3 收起 理由
dyzx + 3

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2017-1-10 16:58 | 显示全部楼层
爱疯 发表于 2017-1-10 16:43
Sub test()
    Dim p As String, f As String
    Dim A(1 To 1000, 1 To 35) As String

爱疯老师:非常多谢老师的指教,多谢。
回复

使用道具 举报

 楼主| 发表于 2017-1-11 09:12 | 显示全部楼层
爱疯 发表于 2017-1-10 16:43
Sub test()
    Dim p As String, f As String
    Dim A(1 To 1000, 1 To 35) As String

爱疯老师:我还有一个问题:就是对于一些复杂的表格应该怎样定位,请指教,多谢。
RR94%[IDSMI_6$[B4GI1A3B.png

word 表格信息汇总00.rar

41.39 KB, 下载次数: 2

回复

使用道具 举报

发表于 2017-1-11 09:30 | 显示全部楼层
在相同高度中,看看没有合并行是在第几行。
在相同宽度中,看看没有合并列是在第几列。


= .cell(4, 4)       '基本信息的身份证号
= .cell(14, 4)       '配偶基本信息的身份证号

评分

参与人数 1 +2 收起 理由
dyzx + 2 很给力

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2017-1-11 09:42 | 显示全部楼层
爱疯 发表于 2017-1-11 09:30
在相同高度中,看看没有合并行是在第几行。
在相同宽度中,看看没有合并列是在第几列。

爱疯老师:非常多谢你的指教,多谢。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 09:15 , Processed in 0.527173 second(s), 18 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表