一般来说,我的问题是我想在列B中找到值,如果它存在于列D中并且将列D中的第一个字符连接到列B.
这是我的初始代码:
Dim ix, ixLastrow as Long
ixLastrow = ShtData.Range("B" & Rows.Count).End(xlUp).Row
For ix = 2 to ixLastrow
If ShtData.Cells(ix, 2).value = ShtData.Cells(ix, 4) then
ShtData.Cells(ix, 3).Value = ShtData.Cells(ix,2) & Left(ShtData.Cells(ix, 4), 2)
End if
Next ix
如果值与ROW和Exact相同的值对齐,则代码有效,但我想要做的是在B列中查找字符串值,然后在列D中搜索匹配。
为了更好地理解我想在这里做什么。请参阅以下示例数据。
Column B | Column D
AAA | IH (for AAF only)
AAB | ID (for AAD only)
AAC |
AAD | IA (for AAA and AAB only)
AAE |
AAF |
如你所见,我的目标是这样的
Column C
AAA IA
AAB IA
AAC
AAD ID
AAE
AAF IH
据我所知,我的代码不能给我这个输出。我仍然是Excel VBA的新手,如果有人能帮助我,我会很高兴。谢谢 :)
下面的代码将满足您的需求。
Option Explicit
Sub AddMatch()
' 23 Dec 2017
Dim Ws As Worksheet
Dim Rng As Range ' the range to search in
Dim Fnd As Range
Dim Rl As Long ' last used row
Dim R As Long
Set Ws = ActiveSheet
Application.ScreenUpdating = False
With Ws
' determine last row in column B
Rl = .Cells(.Rows.Count, "B").End(xlUp).Row
' set the search range in column D, starting in row 2
Set Rng = Range(.Cells(2, 4), .Cells(Rl, 4))
For R = 2 To Rl ' start in row 2
If XlFind(Fnd, Rng, .Cells(R, 2).Value, LookAt:=xlPart) Then
.Cells(R, "C").Value = .Cells(R, "B").Value & " " & Left(Fnd.Value, 2)
End If
Next R
End With
Application.ScreenUpdating = True
End Sub
Function XlFind(Fnd As Range, _
Where As Range, _
ByVal What As Variant, _
Optional ByVal LookIn As Variant = xlValues, _
Optional ByVal LookAt As Long = xlWhole, _
Optional ByVal SearchBy As Long = xlByColumns, _
Optional ByVal StartAfter As Long, _
Optional ByVal Direction As Long = xlNext, _
Optional ByVal MatchCase As Boolean = False, _
Optional ByVal MatchByte As Boolean = False, _
Optional ByVal MatchPosition As Long, _
Optional ByVal After As Range, _
Optional ByVal FindFormat As Boolean = False) As Boolean
' 09 Dec 2017
' Fnd is a return range
' Settings LookIn, LookAt, SearchOrder, and MatchByte
' are saved each time the Find method is used
Dim Search As Range
Dim FirstFnd As Range
Set Search = Where
With Search
If After Is Nothing Then
If StartAfter Then
StartAfter = WorksheetFunction.Min(StartAfter, .Cells.Count)
Else
StartAfter = .Cells.Count
End If
Set After = .Cells(StartAfter)
End If
If MatchPosition > 1 Then LookAt = xlPart
Set Fnd = .Find(What:=What, After:=After, _
LookIn:=LookIn, LookAt:=LookAt, _
SearchOrder:=SearchBy, SearchDirection:=Direction, _
MatchCase:=MatchCase, MatchByte:=MatchByte, _
SearchFormat:=FindFormat)
If Not Fnd Is Nothing Then
Set FirstFnd = Fnd
Do
If MatchPosition Then
If InStr(1, Fnd.Value, What, vbTextCompare) = MatchPosition Then
Exit Do
Else
Set Fnd = .FindNext(Fnd)
End If
Else
Exit Do
End If
Loop While Not (Fnd Is Nothing) And Not (Fnd Is FirstFnd)
End If
End With
XlFind = Not (Fnd Is Nothing)
End Function
功能xlFind
在这里有点过分,但它是我可以从架子上拿走的功能,它的额外功能可能有一天会派上用场。
我认为你所追求的是Like运算符。
在你检查Lee的两个值是否相同的行中,替换为
If Range2.Value Like “*” & Range1.Value & “*” then
为了检查所有行,嵌入另一个For循环,如:
For IX = 1 to IXLastrow
For IY = 1 to IXLastRow
If Range(“D” & IY).Value Like “*” & Range(“B” & IX).Value & “*” Then
Range(“C” & IX).Value = Range(“B” & IX).Value & Left(Range(“D” & IY).Value,2)
Exit For
End If
Next IY
Next IX
根据您的示例,您不需要多个循环,这有点容易理解。
Sub Concte()
Dim lRow As Long
lRow = ShtData.Range("B" & Rows.Count).End(xlUp).Row
For x = 1 To lRow
If Cells(x, 4).Value <> "" Then
Cells(x, 3).Value = Cells(x, 2).Value & " " & Cells(x, 4).Value
End If
Next x
End Sub