[已解决]求1个VBA实现替换效果，根据对照表找出所属环信息

tzjx200521

求1个VBA实现替换效果，根据对照表找出所属环信息，源站和宿站只要同时在对照表的一行，（可用判断如果。。（*云和麻洋*云和沙铺*like云和麻洋,云和黄家畲,云和沙铺，11，44，55,then….. ）所在信息找出唯一的环信息

最佳答案

月排行榜 / 总排行榜

爱疯

2016-4-30 21:55

Sub test()
    Dim A, B, i, j, x
    A = Sheets(1).Range("a1").CurrentRegion
    B = Sheets(2).Range("a1").CurrentRegion

    For j = 2 To UBound(B)
        For i = 2 To UBound(A)
            x = "," & VBA.Replace(A(i, 1), "，", ",") & ","   '统一查找格式
            If InStr(x, "," & B(j, 1) & ",") Then
                If InStr(x, "," & B(j, 2) & ",") Then B(j, 3) = A(i, 2): Exit For
            End If
        Next i
    Next j
    Sheets(2).[a1].Resize(UBound(B), UBound(B, 2)) = B
End Sub

查找所在环路2.rar (10.13 KB, 下载次数: 7)

2016-4-30 21:55 上传

点击文件名下载附件

跳转到最佳答案楼层

爱疯

Sub test()
    Dim A, B, i, j, x
    A = Sheets(1).Range("a1").CurrentRegion
    B = Sheets(2).Range("a1").CurrentRegion

    For j = 2 To UBound(B)
        For i = 2 To UBound(A)
            x = "," & VBA.Replace(A(i, 1), "，", ",") & ","   '统一查找格式
            If InStr(x, "," & B(j, 1) & ",") Then
                If InStr(x, "," & B(j, 2) & ",") Then B(j, 3) = A(i, 2): Exit For
            End If
        Next i
    Next j
    Sheets(2).[a1].Resize(UBound(B), UBound(B, 2)) = B
End Sub

查找所在环路2.rar (10.13 KB, 下载次数: 7)

2016-4-30 21:55 上传

点击文件名下载附件

tzjx200521

爱疯 发表于 2016-4-30 21:55
Sub test()
    Dim A, B, i, j, x
    A = Sheets(1).Range("a1").CurrentRegion

老师果然思路清晰 佩服佩服。。。。。。。