如果匹配,Excel VBA会在另一列中查找值

时间:2017-12-23 02:15:25

标签: excel vba excel-vba

一般来说,我的问题是我想在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的新手,如果有人能帮助我,我会很高兴。 谢谢:))

3 个答案:

答案 0 :(得分:1)

我认为你所追求的是Like运算符。

在检查Lee的两个值是否相同的行中,替换为

newMessageHandler

为了检查所有行,嵌入另一个For循环,如:

If Range2.Value Like “*” & Range1.Value & “*” then

答案 1 :(得分:1)

以下代码可以满足您的需求。

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在这里有点过分,但是我可以从架子上拿出它,它的额外功能可能会在一天派上用场。

答案 2 :(得分:0)

根据您的示例,您不需要多个循环,这有点容易理解。

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