Cells.Find和引用另一个工作簿
我有两本练习册。我需要从WB1中获取一个字符串(我迭代了WB1中的C列，并不是每个单元格都包含字符串，但是当一个单元格包含一个字符串时，这就是我想要复制的字符串)，在WB2中找到它并将其替换为WB1中的另一个字符串(在同一行中，但在A列中)。这是我到目前为止所知道的：
' Checks if a given File is already open
Public Function FileInUse(sFileName) As Boolean
On Error Resume Next
Open sFileName For Binary Access Read Lock Read As #1
Close #1
FileInUse = IIf(Err.Number > 0, True, False)
On Error GoTo 0
End Function
Sub copyPaste()
Dim destWB As Workbook
Dim destSH As Worksheet
Dim fileName As String
Dim curCell As Range
Dim oldName As Range
Dim result As Range
' turn off screen refresh, recalculate formula to speed up sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' For i = 2 To Rows.Count
For i = 2 To 5
fileName = "C:\Users...\" & Workbooks("Ressources calculation.xlsm").Worksheets("Tests costs").Cells(i, 2)
If Not FileInUse(fileName) Then
Set destWB = Workbooks.Open(fileName)
Set destSH = destWB.Sheets("Qualification Matrix")
destSH.Activate
End If
Set curCell = Workbooks("Ressources calculation.xlsm").Sheets("Tests costs").Cells(i, 3)
Set oldName = Workbooks("Ressources calculation.xlsm").Sheets("Tests costs").Cells(i, 1)
If Not IsEmpty(curCell) Then
curCell.Copy
Set result = destWB.Sheets("Qualification Matrix").Cells.Find(What:=oldName.Text, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, MatchByte:=True)
If Not result Is Nothing Then
result.PasteSpecial
End If
End If
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub我在"If Not MsgBox“子句中添加了一个从不触发的结果，所以我猜它找不到单元格。它似乎可以很好地提取我需要使用的字符串(在curCell和oldName中)(也可以用MsgBox检查)。它应该在其中搜索和替换的单元格是合并的单元格，如果这有区别的话。我还尝试了Cells.Find的不同值(保留所有可选参数，尝试了lookIn和lookat的所有可能性，尝试了MatchByte，尝试了oldName.Value )。
这是我第一次使用Excel Macros/VBA做一些事情，在过去的几个小时里，我进行了大量的试验和错误，但没有任何结果。因此，我确信到目前为止我所拥有的远不是最优的，但我希望有人能帮助我。
编辑:我把范围缩小了一点。现在，我在Cells.Find之前激活了destSH，并尝试使用硬编码的示例字符串作为参数，这是可行的。所以我想问题不在于find语句，而在于我如何尝试使用find来提取我要查找的信息。
Edit2:应要求，下面是一个简短的示例演练：
我有一个名为"Ressources calculation.xlsm“的工作簿，它有三列:当前名称、文件名、新名称。第4行如下所示：
Misspelledd [File name].xlsx Misspelled并不是列C中的每个单元格都被填写。我要做的是:遍历C列中的每个单元格，如果它不是空的，复制在同一行但在A列中的字符串，在B列中记录的文件中查找它，并将其替换为写在C列下的正确名称。
这是目标工作簿中单元格的图片，应找到该单元格并按上述说明替换文本。它是一个合并的单元格，延伸到第2-5行。
编辑3:我终于发现问题出在哪里了。在一些单元格的末尾有“看不见”的换行符(不是真正看不见的，但你不容易看到它们，因为后面没有字符)。如果不是这样，代码就会正常工作。
回答 1
Stack Overflow用户
发布于 2020-05-28 01:42:40
尝试如下所示(添加了一些debug.print用于故障排除)
Sub copyPaste()
Dim destWB As Workbook
Dim destSH As Worksheet
Dim fileName As String
Dim curName, oldName
Dim result As Range
Dim wbRes As Workbook, wsTests As Worksheet
Set wbRes = Workbooks("Ressources calculation.xlsm") 'ThisWorkbook ?
Set wsTests = wbRes.Worksheets("Tests costs")
For i = 2 To 5
fileName = "C:\Users...\" & wsTests.Cells(i, 2)
If Not FileInUse(fileName) Then
Set destWB = Workbooks.Open(fileName)
Set destSH = destWB.Sheets("Qualification Matrix")
curName = Trim(wsTests.Cells(i, 3).Value) '<< always worth adding Trim()...
oldName = Trim(wsTests.Cells(i, 1).Value)
If Len(curName) > 0 Then
Debug.Print "Looking for: '" & oldName & _
"' on sheet '" & destSH.Name & "' in " & _
destWB.FullName
Set result = destSH.UsedRange.Find(What:=oldName, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not result Is Nothing Then
Debug.Print "...found"
result.Value = curName
Else
Debug.Print "... not found"
End If
End If
End If 'file not in use
Next i
End Subhttps://stackoverflow.com/questions/62048420
复制相似问题
腾讯云开发者
Copyright © 2013 - 2026 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有
深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 
粤公网安备44030502008569号
腾讯云计算（北京）有限责任公司 京ICP证150476号 | 京ICP备11018762号