![](/img/trans.png)
[英]Search column in one Excel workbook to paste Adjacent Cell's Value into active VBA script
[英]vba to search cell values in another workbook's column
我在workbook1中有一列“ F”,其中包含一些值(使用一些excel公式從其他列中提取並連接后獲得),例如blah-rd1 blah-rd5 blah-rd6 blah-rd48do我想這樣做blah-rd100等
我在工作簿2中有另一列“ D”,其中包含rndm-blah-rd1_sgjgs hjdf-blah-rd5_cnnv sdfhjdf-blah-rd100_cfdnnv ect等值
基本上,“ Blah-rdxx”與其他字符串一起始終存在於workbook2的D列中
現在,我要做的是-如果工作簿2的D列中的值包含工作簿1的F列的值,然后在工作簿1的H列中復制工作簿2的S列的對應值(第5列)
到目前為止,這是我到達的地方,但是它可能不會復制任何內容,因為存在某些問題,並且外循環未進行迭代,我嘗試了以下嵌套嵌套的解決方案:下一個循環:外循環未進行迭代,並添加了n計數器,但外循環仍然沒有重復-
Sub findandcopy()
Dim r As Range
Dim f As Range
Dim i As Long
Dim j As Long
Dim w1 As Worksheet
Dim w2 As Worksheet
Dim n As Integer
Set w1 = Workbooks("Book1.xlsm").Worksheets("sheet1")
Set w2 = Workbooks("Book2.xlsx").Worksheets("sheet1")
n = 0
For i = 1 To w2.Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To w1.Cells(Rows.Count, 1).End(xlUp).Row + n
If InStr(1, w2.Cells(i, 1).Value, w1.Cells(j, 3).Value) > 0 Then
w2.Cells(i, 2).Copy (w2.Cells(j, 5))
Exit For
n = n + 1
End If
Next j
Next i
End Sub
嘗試這個
Option Explicit
Public Sub FindAndCopy()
Const F = "F"
Const D = "D"
Const H = 2
Const S = 15
Dim ws1 As Worksheet: Set ws1 = Workbooks("Book1.xlsm").Worksheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Workbooks("Book2.xlsm").Worksheets("Sheet1")
Dim lr1 As Long: lr1 = ws1.Cells(ws1.Rows.Count, F).End(xlUp).Row
Dim lr2 As Long: lr2 = ws2.Cells(ws2.Rows.Count, D).End(xlUp).Row
Dim itm1 As Range, itm2 As Range
Application.ScreenUpdating = False
For Each itm2 In ws2.Range(ws2.Cells(1, D), ws2.Cells(lr2, D)) 'Book2
For Each itm1 In ws1.Range(ws1.Cells(1, F), ws1.Cells(lr1, F)) 'Book1
If Not IsError(itm1) And Not IsError(itm2) Then
If InStr(1, itm2.Value2, itm1.Value2) > 0 Then
itm1.Offset(, H).Formula = itm2.Offset(, S).Formula 'Book1.H = Book2.S
Exit For
End If
End If
Next
Next
Application.ScreenUpdating = True
End Sub
原始代碼,其中包含功能問題的說明:
Sub findandcopy()
Dim w1 As Worksheet, w2 As Worksheet
Dim i As Long, j As Long, n As Integer
Set w1 = Workbooks("Book1.xlsm").Worksheets("sheet1")
Set w2 = Workbooks("Book2.xlsx").Worksheets("sheet1")
n = 0
For i = 1 To w2.Cells(Rows.Count, 1).End(xlUp).Row 'for each used cell in w2.colA
For j = 1 To w1.Cells(Rows.Count, 1).End(xlUp).Row + n 'for each used cell in w1.colA
'Find the text from w1.colC (current w1 row), within cell in w2.colA (current w2 row)
If InStr(1, w2.Cells(i, 1).Value, w1.Cells(j, 3).Value) > 0 Then
'If found then copy cell in w2.colB into cell in w2.colE (current w2 row)
w2.Cells(i, 2).Copy (w2.Cells(i, 5))
Exit For 'this exits the inner For loop
n = n + 1 'this would jump over the next cell(s) in w1, but never executes
End If
Next j
Next i
End Sub
#N/A, #VALUE!, #REF!, #DIV/0!, #NUM!, #NAME?, or #NULL!
如果您想對代碼進行更詳細的審查,請在修復后將其發布到“代碼審查”中
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.