曼城足球论坛技术论坛

找回密码
收费注册

QQ登录

只需一步,快速先导

EH征采
EH技术汇-专业的职场手艺充电站 妙哉!函数段子手兴味讲函数 足球任职器-会足球,做管理系统 足球 Home精品图文教程库
足球不给力? 何不试试FoxTable! 足球 2016函数公式学习大典 Office知识技巧收费学 制造主题竞争力的职场宝典
Tableau-数据可视化工具 曼城足球论坛出品 - VBA代码宝收费下载
你的足球 2010实战技巧学习锦囊 不能自休, 过目难忘的 Office 新界面 足球 VBA典范代码实验指南
巡视: 172 | 回复: 4
打印 上一主题 下一主题

[求助] 襄助把word表格中的形式齐备提到excel

[复制链接]

TA的精华主题

TA的得分主题

跳转到指定楼层
1
楬橥于 2020-9-15 11:42 | 只看该作者 | 只看大图 回帖夸奖 | 倒序赏玩 | 阅读形式
本帖最后由 xiong0410 于 2020-9-15 12:00 编辑


image.jpg (84.97 KB, 下载次数: 1)

image.jpg

新建文件夹 (2).zip

75.55 KB, 下载次数: 21

TA的精华主题

TA的得分主题

2
楬橥于 2020-9-15 11:58 | 只看该作者
你是喝醉了么?

TA的精华主题

TA的得分主题

3
楼主 | 楬橥于 2020-9-15 11:59 | 只看该作者
本帖最后由 xiong0410 于 2020-9-15 12:00 编辑

失误
lgs

TA的精华主题

TA的得分主题

4
楬橥于 2020-9-15 12:50 | 只看该作者
本帖最后由 liulang0808 于 2020-9-15 12:52 编辑

Sub 汇总所有数据()
Dim ff As String, path As String,最火的足彩论坛。 a As Integer, Filename As String
ff = "Word文档(*.doc;*.最火的足彩论坛。docx),*.doc;*.docx "
strtitle = "掀开Word文档"
path = Application.GetOpenFilename(filefilter:=ff,最火的足彩论坛。 Title:=strtitle)
path = Mid(path, 1,足球吧论坛。 InStrRev(path, "\"))
Filename = Dir(path)
k = 2
Do While Filename <> ""
Set docapp = CreateObject("Word.application"),足球交流论坛。
Set dd = docapp.documents.球迷007足球论坛。Open(path & Filename)
Set ddd1 = dd.Tables(1)
x = ddd1.Range.Rows.Count
For i = 2 To x
Cells(k, 2) = ddd1.cell(i, 1).Range
Cells(k, 3) = ddd1.最火的足彩论坛。cell(i, 2).Range
Cells(k, 4) = ddd1.足球论坛哪个火。cell(i, 3).Range
Cells(k, 5) = ddd1.cell(i, 4).Range
Cells(k, 6) = ddd1.足球吧论坛。cell(i, 5).Range
Cells(k, 7) = ddd1.足球襄助把word表格最火的足彩论坛中的方式一概提到excel。cell(i, 6).Range
k = k + 1
Next
dd.Close
docapp.Quit
Set docapp = Nothing
Set dd = Nothing
Set ddd1 = Nothing

Filename = Dir

Loop
Cells(1, 1) = "表名"
Cells(1, 2) = "item"
Cells(1, 3) = "Lot No"
Cells(1, 4) = "Part Name"
Cells(1, 5) = "P Part Number"
Cells(1, 6) = "Part Number",足球VBA措施征战。
Cells(1, 7) = "Released Quantity "
End Sub



评分

参与人数 1 鲜花 +2 收起 理由
lygyjt + 2 优秀作品

巡视齐备评分

TA的精华主题

TA的得分主题

5
楬橥于 2020-9-15 13:28 | 只看该作者
Sub 提取表格形式()
myPath = ThisWorkbook.Path & "\",曼城足球论坛技术论坛。
myName = Dir(myPath & "*.doc"),足球。
m = 1
a = 1
Do While myName <> ""
Cells(a, 1) = myName
Set myDoc = GetObject(myPath & myName)
With myDoc.Tables(1)
For Each mCell In .Range.襄助。Cells
n = n + 1
If n Mod 7 = 0 Then,word。
m = m + 1
n = 1
End If
Cells(m, n + 1) = Replace(mCell.表格。Range.Text, Chr(13) & Chr(7), "")
Next
myDoc.Close False
End With
a = m + 1
myName = Dir()
Loop
Set myDoc = Nothing
MsgBox "提取完成"
End Sub

TA的精华主题

TA的得分主题

6
楼主 | 楬橥于 2020-9-15 14:17 | 只看该作者
本帖最后由 xiong0410 于 2020-9-16 12:10 编辑
ammyc 楬橥于 2020-9-15 13:28
Sub 提取表格形式()
myPath = ThisWorkbook.Path & "\"
myName = Dir(myPath & "*.doc")

大神。

image.png (61.11 KB, 下载次数: 1)

image.png
您需要登录后才可能回帖 登录 | 收费注册

本版积分规则

体贴官方微信,每天学会一个新手艺

手机版|关于我们|干系我们|曼城足球论坛

GMT+8, 2020-9-28 14:27, Processed in 0.0 second(s),论坛。 15 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

? 1999-2021 Wooffice Inc.

沪公网安备号 沪ICP备号

本论坛言论纯属楬橥者小我意见,任何违反国度相关法律的言论。

快速回复 前往顶部 前往列表