请大神用VB指导

石来运转6888

请大神用VB指导,查找

zjdh

看不懂！！

vba韭菜

给你参考一下：

Sub FillNColumnWithMatchingName()

    Dim ws As Worksheet
    Set ws = ActiveSheet ' 修改为实际工作表对象，如：ThisWorkbook.Worksheets("Sheet1")

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "M").End(xlUp).Row

    Dim i As Long
    For i = 8 To lastRow ' 从第8行开始遍历

        ' 检查M列和N列的值
        If Not IsEmpty(ws.Cells(i, "M")) Then ' M列不为空

            If IsEmpty(ws.Cells(i, "N")) Then ' N列为空，需要查找并填充

                Dim searchValue As Variant
                searchValue = ws.Cells(i, "M").Value

                Dim foundMatch As Boolean
                foundMatch = False

                Dim matchRow As Long
                For j = 8 To lastRow ' 在B、C列中查找相同项
                    If (ws.Cells(j, "B") = searchValue Or ws.Cells(j, "C") = searchValue) And _
                       ws.Cells(j, "D") <> "" Then ' 找到匹配项且D列有户名

                        ws.Cells(i, "N").Value = ws.Cells(j, "D").Value ' 填充户名到N列
                        foundMatch = True
                        Exit For ' 一旦找到匹配项，跳出内层循环
                    End If
                Next j

                If Not foundMatch Then ' 没有找到匹配项，保持N列为空
                    ws.Cells(i, "N").ClearContents
                End If

            End If ' N列为空的情况

        End If ' M列不为空的情况

    Next i

End Sub

ykcbf1100

vba韭菜 发表于 2024-4-17 20:00
给你参考一下：

Sub FillNColumnWithMatchingName()

AI写的代码？你测试过没有？

3190496160

数组+字典可以轻松搞定，
先把b，c两列赋值给字典，并记录行号，然后循环m列，在字典中存在则把d列的值赋值给n列，否则，n列为空

LIUZHU

用公式解决吧，不要用VBA，两个Vlookup的事情。
=IFERROR(VLOOKUP($M7,$B:$D,3,),"")&IFERROR(VLOOKUP($M7,$C:$D,2,),"")

3190496160

Sub 查询()
Dim ar As Variant
Dim i As Long, r As Long
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("原表")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:n" & r)
    For i = 2 To UBound(ar)
        If ar(i, 2) <> "" Then
            d(ar(i, 2)) = i
        End If
        If ar(i, 3) <> "" Then
            d(ar(i, 3)) = i
        End If
    Next i
    For i = 2 To UBound(ar)
        If ar(i, 13) <> "" And ar(i, 14) = "" Then
            xh = d(ar(i, 13))
            If xh <> "" Then
                ar(i, 14) = ar(xh, 4)
            End If
        End If
    Next i
    .[n1].Resize(UBound(ar), 1) = Application.Index(ar, 0, 14)
End With
MsgBox "ok!"
End Sub

3190496160

请大神用VB指导.rar (17.58 KB, 下载次数: 5)

2024-4-18 10:37 上传

点击文件名下载附件