此代码用于更新源文档中的客户端信息，以便从我可以随时从客户端服务器提取的列表中进行邮件合并。
我在接近结尾的代码中遇到了麻烦。它目前经历的过程如下：
我目前陷入第四步和第五步之间。＆＃39;
这里选择的代码我试图适应搜索源工作簿，但我认为这不会起作用 - 我需要将找到的术语粘贴到宏工作簿中，我在这里对VBA的知识存在差距。
如果有必要，我可以发布我的完整代码，但我并不想立即抛弃所有内容。
提前致谢！
Set sourcewkb = ActiveWorkbook
Dim rnnng As Range
Dim searchfor As String
Debug.Print celld
searchfor = celld
Set rnnng = Selection.Find(what:=searchfor)
If rnnng Is Nothing Then
Debug.Print "yes"
Else
Debug.Print "no"
End If
修改
我尝试了评论中提出的一些内容，但是我遇到了一个问题，即selection.find正在查找有问题的变量，看看它是否真的存在。我想它在两个工作簿中都在搜索？
完整代码（为了方便起见，在编辑代码时，某些部分标记为注释，它们通常不是我关注的部分）：
更新完整代码：
Sub addressfinder()
Dim rCell
Dim rRng As Range
Dim aftercomma As String
Dim celld As String
Dim s As String
Dim indexOfThey As Integer
Dim mrcell As Range
Dim alreadyfilled As Boolean
Dim nocompany As Boolean
Dim sourcewkb
Dim updaterwkb
Dim fd As FileDialog
Dim cellstocopy As Range
Dim cellstopaste As Range
Dim x As Byte
'select updater workbook
updaterwkb = "L:\Admin\Corporate Books\2015\letter macro\Annual Consent Letter Macro.xlsm"
'this is the finished updater workbook selecter.
' Set fd = Application.FileDialog(msoFileDialogFilePicker)
'
'
' Dim vrtselecteditem As Variant
' MsgBox "select the Annual Consent Letter Macro workbook"
'
' With fd
' If .Show = -1 Then
' For Each vrtselecteditem In .SelectedItems
'
'
' updaterwkb = vrtselecteditem
' Debug.Print updaterwkb
' Next vrtselecteditem
' Else
' End If
' End With
'select file of addresses
sourcewkb = "L:\Admin\Corporate Books\2015\letter macro\source workbook_sample.xlsx"
'this is the finished source select code
' Dim lngcount As Long
' If MsgBox("Have you gotten this year's updated contact list exported from Time Matters or Outlook?", vbYesNo, "confirm") = vbYes Then
' If MsgBox("Is the information in that excel workbook formatted per the instructions?", vbYesNo, "Confirm") = vbYes Then
' MsgBox "Good. Select that workbook now."
' Else
' MsgBox "Format the workbook before trying to update the update list"
' End If
' Else
' MsgBox "Have someone export you a client list with company name, client name, and client address"
'
' End If
'
'
' With Application.FileDialog(msoFileDialogOpen)
' .AllowMultiSelect = False
' .Show
' For lngcount = 1 To .SelectedItems.Count
' Debug.Print .SelectedItems(lngcount)
' sourcewkb = .SelectedItems(lngcount)
'
' Next lngcount
' End With
'
Workbooks.Open (sourcewkb)
'start the code
Set updaterwkb = ActiveWorkbook
Set rRng = Sheet1.Range("a2:A500")
For Each rCell In rRng.Cells
'boolean resets
alreadyfilled = False
nocompany = False
'setting up the step-through
s = rCell.Value
indexOfThey = InStr(1, s, ",")
aftercomma = Right(s, Len(s) - indexOfThey + 1)
celld = Left(s, Len(s) - Len(aftercomma))
Debug.Print rCell.Value, "celld", celld
Debug.Print "address", rCell.Address
'setting up already filled check
Set mrcell = rCell.Offset(rowoffset:=0, ColumnOffset:=6)
Debug.Print "mrcell", mrcell.Value
If Len(rCell.Formula) = 0 Then
Debug.Print "company cell sure looks empty"
nocompany = True
End If
If Len(mrcell.Formula) > 0 Then
Debug.Print "mrcell has content"
alreadyfilled = True
Else: Debug.Print "mrcell has no content"
End If
If alreadyfilled = False Then
If nocompany = False Then
'the code for copying stuff
'open source document
'search source document for contents of celld
'if contents of celld are found, copy everything to the right of the cell in which
'they were found and paste it horizontally starting at mrcell
'if not, messagebox "address for 'celld' not found
'Set sourcewkb = ActiveWorkbook
'
'Dim rnnng As Range
'Dim searchfor As String
'Debug.Print celld
'searchfor = celld
'
'Set rnnng = Selection.Find(what:=searchfor)
'If Not rnnng Is Nothing Then
' Debug.Print "yes"
' Else
' Debug.Print "no"
'
'End If
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim company As String
Dim lastRow As Long
Dim rng As Variant
Dim llc As String
Dim inc As String
Dim searchfor As String
Set wb1 = ThisWorkbook
Set wb2 = Workbooks("source workbook_sample.xlsx") 'change workbook name
Set ws1 = ThisWorkbook.Worksheets(1) 'change worksheet #
Set ws2 = wb2.Worksheets(1) 'change worksheet #
llc = ",LLC"
inc = ",INC."
'lastRow = ws1.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
With ws1
For i = 1 To 500
If Cells(i, 1).Value = searchfor Then
company = .Cells(i, 1)
With ws2
'change range as necessary
Set f = .Range("A1:D100").Find(company, LookIn:=xlValues)
If Not f Is Nothing Then
Debug.Print searcfor
fRow = f.Row
rng = .Range("B" & fRow & ":D" & fRow)
ws1.Range("B" & i & ":D" & i) = rng
End If
End With
End If
Next
End With
'
Else
Debug.Print "skipped cuz there ain't no company"
End If
Else
Debug.Print "skipped cuz it's filled"
End If
''
'
Debug.Print "next"
Next rCell
End Sub
固定代码：
With ws1
For i = 1 To 500
If Cells(i, 1).Value = searchfor Then
company = .Cells(i, 1)
With ws2
'change range as necessary
Set f = .Range("A1:D100").Find(company, LookIn:=xlValues)
If Not f Is Nothing Then
Debug.Print searcfor
fRow = f.Row
rng = .Range("B" & fRow & ":D" & fRow)
ws1.Range("B" & i & ":D" & i) = rng
End If
End With
End If
Next
End With
答案 0 :(得分：0)
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim company As String
Dim lastRow As Long
Dim rng As Variant
Dim llc As String
Dim inc As String
Dim searchfor As String
Set wb1 = ThisWorkbook 'Annual Consent Letter Macro
Set wb2 = Workbooks("source workbook_sample.xlsx")
Set ws1 = ThisWorkbook.Worksheets(1)
Set ws2 = wb2.Worksheets(1)
llc = ",LLC"
inc = ",INC."
With ws1
For i = 1 To 500
If Cells(i, 1).Value = searchfor Then
company = .Cells(i, 1)
With ws2
'change range as necessary
Set f = .Range("A1:A500").Find(company, LookIn:=xlValues)
If Not f Is Nothing Then
Debug.Print searcfor
fRow = f.Row
rng = .Range("B" & fRow & ":D" & fRow)
ws1.Range("B" & i & ":D" & i) = rng
End If
End With
End If
Next
End With
End Sub