[已解决]根据某两列判断供应商选择谁

透明世界1987

判断供应商.zip (178.66 KB, 下载次数: 11)

2022-11-15 11:04 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

cutecpu

2022-11-15 16:55

透明世界1987 发表于 2022-11-15 16:38
感谢大神，但是不太对哦。当A列对应的三个名字，比如井道材料他有很多行数据，您的代码只是检测C列包含XX ...

Sub 处理页_按钮14_Click()
    rq = Range("V2")
    E = Range("S65536").End(3).Row
    Range("V3:V" & E) = rq
    For h = 3 To E
        If Cells(h, "S") = "兆元" Then Cells(h, "V") = Cells(h, "V") - 0
        If InStr("奥德普、力旭、西泰、立诺、久联、利德尔、喜飞翔、新意科技", Cells(h, "S")) Then Cells(h, "V") = Cells(h, "V") - 2
        If InStr("莱升、欧开、捷成", Cells(h, "S")) Then Cells(h, "V") = Cells(h, "V") - 1
    Next


    Dim i&, j%, r&, c%, n%, x%, arr, brr, GysAr, d As Object
    Set d = CreateObject("Scripting.Dictionary")
    With Sheets("供应商选择")
        r = .[A1].CurrentRegion.Rows.Count
        c = .[A1].CurrentRegion.Columns.Count
        GysAr = .[A1].Resize(r, c + 1)
        For i = 2 To UBound(GysAr)
            n = 0
            For j = 2 To c
                If Len(GysAr(i, j)) Then n = n + 1
            Next
            If n Then GysAr(i, c + 1) = n: d(GysAr(i, 1)) = i
        Next
    End With
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("处理页")
        arr = .[A1].CurrentRegion
        brr = .[s2].Resize(UBound(arr) - 1)
        For i = 2 To UBound(arr)
            r = d(arr(i, 1))
            If r Then
                x = Day(arr(i, 22))
                n = x Mod GysAr(r, c + 1)
                If n Then
                    brr(i - 1, 1) = GysAr(r, n + 1)
                Else
                    brr(i - 1, 1) = GysAr(r, GysAr(r, c + 1) + 1)
                End If
            End If
            if ( arr(i, 1) = "井道材料" or arr(i,1) = "对重架&对重轮" or arr(i,1) = "绳轮" ) and arr(i,3) like "*XXA*" then
               dic(arr(i, 1)) = 1
            end if
        Next
        for i = 2 to ubound(arr)
           if dic(arr(i,1)) then
              brr(i-1,1) = "永德"
           end if           
        next
        .[s2].Resize(UBound(brr)) = brr
    End With
End Sub

跳转到最佳答案楼层

cutecpu

Sub 处理页_按钮14_Click()
    rq = Range("V2")
    E = Range("S65536").End(3).Row
    Range("V3:V" & E) = rq
    For h = 3 To E
        If Cells(h, "S") = "兆元" Then Cells(h, "V") = Cells(h, "V") - 0
        If InStr("奥德普、力旭、西泰、立诺、久联、利德尔、喜飞翔、新意科技", Cells(h, "S")) Then Cells(h, "V") = Cells(h, "V") - 2
        If InStr("莱升、欧开、捷成", Cells(h, "S")) Then Cells(h, "V") = Cells(h, "V") - 1
    Next


    Dim i&, j%, r&, c%, n%, x%, arr, brr, GysAr, d As Object
    Set d = CreateObject("Scripting.Dictionary")
    With Sheets("供应商选择")
        r = .[A1].CurrentRegion.Rows.Count
        c = .[A1].CurrentRegion.Columns.Count
        GysAr = .[A1].Resize(r, c + 1)
        For i = 2 To UBound(GysAr)
            n = 0
            For j = 2 To c
                If Len(GysAr(i, j)) Then n = n + 1
            Next
            If n Then GysAr(i, c + 1) = n: d(GysAr(i, 1)) = i
        Next
    End With
    With Sheets("处理页")
        arr = .[A1].CurrentRegion
        brr = .[s2].Resize(UBound(arr) - 1)
        For i = 2 To UBound(arr)
            r = d(arr(i, 1))
            If r Then
                x = Day(arr(i, 22))
                n = x Mod GysAr(r, c + 1)
                If n Then
                    brr(i - 1, 1) = GysAr(r, n + 1)
                Else
                    brr(i - 1, 1) = GysAr(r, GysAr(r, c + 1) + 1)
                End If
            End If
            if ( arr(i, 1) = "井道材料" or arr(i,1) = "对重架&对重轮" or arr(i,1) = "绳轮" ) and arr(i,3) like "*XXA*" then
               brr(i-1,1) = "永德"
            end if
        Next
        .[s2].Resize(UBound(brr)) = brr
    End With
End Sub

透明世界1987

cutecpu 发表于 2022-11-15 11:49
Sub 处理页_按钮14_Click()
    rq = Range("V2")
    E = Range("S65536").End(3).Row

感谢大神，但是不太对哦。当A列对应的三个名字，比如井道材料他有很多行数据，您的代码只是检测C列包含XXA这一行的供应商变为了永德，我需要当井道材料里 C列只要有一个XXA存在那么整个井道材料对应行都是永德

cutecpu

透明世界1987 发表于 2022-11-15 16:38
感谢大神，但是不太对哦。当A列对应的三个名字，比如井道材料他有很多行数据，您的代码只是检测C列包含XX ...

Sub 处理页_按钮14_Click()
    rq = Range("V2")
    E = Range("S65536").End(3).Row
    Range("V3:V" & E) = rq
    For h = 3 To E
        If Cells(h, "S") = "兆元" Then Cells(h, "V") = Cells(h, "V") - 0
        If InStr("奥德普、力旭、西泰、立诺、久联、利德尔、喜飞翔、新意科技", Cells(h, "S")) Then Cells(h, "V") = Cells(h, "V") - 2
        If InStr("莱升、欧开、捷成", Cells(h, "S")) Then Cells(h, "V") = Cells(h, "V") - 1
    Next


    Dim i&, j%, r&, c%, n%, x%, arr, brr, GysAr, d As Object
    Set d = CreateObject("Scripting.Dictionary")
    With Sheets("供应商选择")
        r = .[A1].CurrentRegion.Rows.Count
        c = .[A1].CurrentRegion.Columns.Count
        GysAr = .[A1].Resize(r, c + 1)
        For i = 2 To UBound(GysAr)
            n = 0
            For j = 2 To c
                If Len(GysAr(i, j)) Then n = n + 1
            Next
            If n Then GysAr(i, c + 1) = n: d(GysAr(i, 1)) = i
        Next
    End With
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("处理页")
        arr = .[A1].CurrentRegion
        brr = .[s2].Resize(UBound(arr) - 1)
        For i = 2 To UBound(arr)
            r = d(arr(i, 1))
            If r Then
                x = Day(arr(i, 22))
                n = x Mod GysAr(r, c + 1)
                If n Then
                    brr(i - 1, 1) = GysAr(r, n + 1)
                Else
                    brr(i - 1, 1) = GysAr(r, GysAr(r, c + 1) + 1)
                End If
            End If
            if ( arr(i, 1) = "井道材料" or arr(i,1) = "对重架&对重轮" or arr(i,1) = "绳轮" ) and arr(i,3) like "*XXA*" then
               dic(arr(i, 1)) = 1
            end if
        Next
        for i = 2 to ubound(arr)
           if dic(arr(i,1)) then
              brr(i-1,1) = "永德"
           end if           
        next
        .[s2].Resize(UBound(brr)) = brr
    End With
End Sub