VBA在Word文档中查找特定文本并将此文本从Word文档复制到Excel中的单元格中 [英] VBA to find specific text in word doc and copy this text from word doc into a cell in excel
问题描述
你好stackoverflow社区.
到目前为止，我一直在手动从以前打开的Word文档中复制价格，然后将其粘贴到Excel工作表中. 这是当时在计算机上打开的唯一.docx文件，因此我们只需要在当前打开的word文件中查找价格即可. 我希望U可以帮助我自动完成这项任务.
此图显示了我从中复制价格的那部分文档. 在此示例中为605.000.但是我不知道价格，然后再在Word文件中检查价格. Word文件是我了解价格的地方. 所选文本在整个文档中仅出现一次，因此我需要VBA复制"brutto w kwocie"之后直到第一个昏迷的内容. 是的-仅金额不包含小数的金额，因为它们始终为00. 但是不仅有七个标志，因为如果我的公寓价格为1.250.000，那么仅复制7个标志的宏将不起作用.
Sub Find_Price()
'Variables declaration
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim TextToFind As String
Dim ApartmentPrice As String
Dim Rng As Word.Range
Application.ScreenUpdating = False
'This is the text I'm looking for in .ActiveDocument
TextToFind = "brutto w kwocie "
'Start Word and create an object
'Set WordApp = CreateObject("Word.Application")
'Reference already opened Word document from excel VBA console
Set WordApp = GetObject(, "Word.Application")
WordApp.Application.Visible = True
Set Rng = WordApp.ActiveDocument.Content
'Set WordDoc = WordApp.ActiveDocument 'I don't know how to finish this line
Rng.Find.Execute FindText:=TextToFind, Forward:=True
'what this "Forward:=True" means??
If Rng.Find.Found Then
If Rng.Information(wdWithInTable) Then
'I don't know how to write this part of the code.
'Please don't remove my question again - I've researched 16h for this info.
MsgBox "Price is " & ApartmentPrice & " pln."
End If
Else
MsgBox "Apartment price was not found!"
End If
Set ws = ActiveSheet 'currently opened sheet on currently opened.xlsm file
ws.Range("E27").Activate
ws.Paste
End Sub
然后我需要从金额中间的这个荒谬点中删除数字，所以请帮助我将605.000清除为60500或1.250.000清除为1250000.
当我在剪贴板中有此数字(价格)时，我需要将其粘贴到当前打开的excel文件，.activesheet中(因为excel文件和excel工作表的名称每天都会更改多次). 但是目标单元格始终是E27-它永远不会改变.
谢谢大家的帮助.
编辑24.01.2020 这是我根据我的最佳能力修改的上述代码.
Sub Find_Corrected()
'Variables declaration
'Dim WordApp As Object
Dim WordApp As Word.Application
'Dim WordDoc As Object
Dim WordDoc As Word.Document
Dim TextToFind As String
Dim ApartmentPrice As String
Dim Rng As Word.Range
Application.ScreenUpdating = False
'This is the text I'm looking for in .ActiveDocument
TextToFind = "brutto w kwocie "
'Start Word and create an object
'Set WordApp = CreateObject("Word.Application")
'Reference already opened Word document from excel VBA console
Set WordApp = GetObject(, "Word.Application")
Set WordDoc = WordApp.ActiveDocument
Set Rng = WordApp.ActiveDocument.Content
WordApp.Application.Visible = True
'Set WordDoc = WordApp.Documents.Open(FilePath & "Form1.docx")
'Set WordDoc = WordApp.ActiveDocument 'I don't know how to finish this line :-(
Rng.Find.Execute FindText:=TextToFind, Forward:=True
'what this "Forward:=True" means??
With Rng.Find
.Text = "brutto w kwocie "
.Execute
If .Found = True Then
Rng.MoveEnd wdWord, 3
Rng.Copy
MsgBox "Copied value equals " & Rng.Value & " Roesler conquers."
Else
MsgBox "Requested range was not found!"
End If
End With
'Set ws = ActiveSheet ' currently opened sheet on currently opened.xlsm file
'ws.Range("E27").Activate
'ws.Paste
End Sub
这是它返回的错误.
您可以使用与您的另一个问题.
创建一个范围，将其设置为等于整个文档，沿该范围搜索，移动到所需的终止范围，然后将范围的起始位置移至您的数字.
Dim srchRng as Range
Set srchRng = ActiveDocument.Content
With srchRng.Find
.Text = "brutto w kwocie "
.Execute
If .Found = True Then
Dim numberStart as Long
numberStart = Len(srchRng.Text) + 1
srchRng.MoveEndUntil Cset:=","
Dim myNum as String
myNum = Mid(srchRng.Text, numberStart)
End If
End With
Hello stackoverflow community.
What I'm doing until now, is I manually copy a price from the word document, which I previously open, and paste it into an Excel sheet. It is the only .docx file opened at the time on computer, so we just need to find the price in currently opened word file. I'd like U to help me automate this task.
This picture shows the part of the document from where I copy the price. In this example it's 605.000. But I don't know the price before I check it in the word file. The word file is a place where I learn what the price is. The selected text occurs only once in the whole document therefore I need VBA to copy what's after "brutto w kwocie " and up to the first coma. Yes - only the amount of money without decimal values, because they're always ,00. But not only seven signs, because if I had apartment price 1.250.000 then the macro that copies only 7 signs wouldn't work.
Sub Find_Price()
'Variables declaration
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim TextToFind As String
Dim ApartmentPrice As String
Dim Rng As Word.Range
Application.ScreenUpdating = False
'This is the text I'm looking for in .ActiveDocument
TextToFind = "brutto w kwocie "
'Start Word and create an object
'Set WordApp = CreateObject("Word.Application")
'Reference already opened Word document from excel VBA console
Set WordApp = GetObject(, "Word.Application")
WordApp.Application.Visible = True
Set Rng = WordApp.ActiveDocument.Content
'Set WordDoc = WordApp.ActiveDocument 'I don't know how to finish this line
Rng.Find.Execute FindText:=TextToFind, Forward:=True
'what this "Forward:=True" means??
If Rng.Find.Found Then
If Rng.Information(wdWithInTable) Then
'I don't know how to write this part of the code.
'Please don't remove my question again - I've researched 16h for this info.
MsgBox "Price is " & ApartmentPrice & " pln."
End If
Else
MsgBox "Apartment price was not found!"
End If
Set ws = ActiveSheet 'currently opened sheet on currently opened.xlsm file
ws.Range("E27").Activate
ws.Paste
End Sub
Then I need to strip the number from this ridiculous dot in the middle of the amount, so please help me clear 605.000 into 60500 or 1.250.000 into 1250000.
When I have this number (the price) in my clipboard, I need to paste it into currently opened excel file, into .activesheet (because the name of the excel file and excel sheet will change many times a day). But the destination cell will always be E27 - it will never change.
Thank you guys for all the help.
EDIT 24.01.2020 This is the above mentioned code amended by me to my best abilities.
Sub Find_Corrected()
'Variables declaration
'Dim WordApp As Object
Dim WordApp As Word.Application
'Dim WordDoc As Object
Dim WordDoc As Word.Document
Dim TextToFind As String
Dim ApartmentPrice As String
Dim Rng As Word.Range
Application.ScreenUpdating = False
'This is the text I'm looking for in .ActiveDocument
TextToFind = "brutto w kwocie "
'Start Word and create an object
'Set WordApp = CreateObject("Word.Application")
'Reference already opened Word document from excel VBA console
Set WordApp = GetObject(, "Word.Application")
Set WordDoc = WordApp.ActiveDocument
Set Rng = WordApp.ActiveDocument.Content
WordApp.Application.Visible = True
'Set WordDoc = WordApp.Documents.Open(FilePath & "Form1.docx")
'Set WordDoc = WordApp.ActiveDocument 'I don't know how to finish this line :-(
Rng.Find.Execute FindText:=TextToFind, Forward:=True
'what this "Forward:=True" means??
With Rng.Find
.Text = "brutto w kwocie "
.Execute
If .Found = True Then
Rng.MoveEnd wdWord, 3
Rng.Copy
MsgBox "Copied value equals " & Rng.Value & " Roesler conquers."
Else
MsgBox "Requested range was not found!"
End If
End With
'Set ws = ActiveSheet ' currently opened sheet on currently opened.xlsm file
'ws.Range("E27").Activate
'ws.Paste
End Sub
And this is the error it returns.
You can use the same method that I used in an answer to another of your questions.
Create a range, set it equal to the whole document, search along the range, move until your desired stop range, then move the start of the range up to your numbers.
Dim srchRng as Range
Set srchRng = ActiveDocument.Content
With srchRng.Find
.Text = "brutto w kwocie "
.Execute
If .Found = True Then
Dim numberStart as Long
numberStart = Len(srchRng.Text) + 1
srchRng.MoveEndUntil Cset:=","
Dim myNum as String
myNum = Mid(srchRng.Text, numberStart)
End If
End With
这篇关于VBA在Word文档中查找特定文本并将此文本从Word文档复制到Excel中的单元格中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
