samwang

¦^´_ 1# stephenlee

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, xD, T$, br, a1$, a2$, ky, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Sheets(1).Range("a1").CurrentRegion
For i = 2 To UBound(Arr): T = Arr(i, 1): xD(T) = Arr(i, 2): Next
With Sheets(2)
    Arr = .Range("a1").CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 1): If T = "" Then GoTo 99
        If xD.Exists(T) Then
            Arr(i, 2) = xD(T)
        Else
            a1 = Split(Split(T, "(")(1), "-")(0)
            a2 = Split(Split(Split(T, "(")(1), "-")(1), ")")(0)
            For Each ky In xD.keys
                br = Split(ky, "-"): If UBound(br) < 2 Then GoTo 98
                If br(2) >= a1 And br(2) <= a2 Then
                    If Arr(i, 2) = "" Then
                        Arr(i, 2) = xD(ky)
                    Else
                        Arr(i, 2) = Arr(i, 2) & "/" & xD(ky)
                    End If
                End If
98:          Next
        End If
99:     Next
    .[a1].Resize(UBound(Arr), 2) = Arr
End With
End Sub

samwang

§A¦n,¤j¤j

ÁÂÁ»դUªá¤F³o»ò¦h®É¶¡À°§Ú»s§@¤F³o­ÓVBA, ³o­ÓVBA §¹¥þ²Å¦X§Úªº­n¨D,«D±`·PÁÂ,¤j ...
stephenlee µoªí©ó 2022-8-8 16:43

½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, xD, T$, i&
Set xD = CreateObject("Scripting.Dictionary")
With Sheets(2)
    Arr = .Range("a1").CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 1) & "|" & Arr(i, 2): xD(T) = Arr(i, 3)
        T = Arr(i, 1) & "|" & Split(Arr(i, 2), "-")(0): xD(T) = Arr(i, 3)
    Next
End With
With Sheets(1)
    Arr = .Range("a1").CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 1) & "|" & Arr(i, 2)
        If xD.exists(T) Then
            Arr(i, 3) = xD(T)
        Else
            T = Arr(i, 1) & "|" & Split(Arr(i, 2), "-")(0): Arr(i, 3) = xD(T)
        End If
    Next
    .Range("a1").Resize(UBound(Arr), 3) = Arr
End With
End Sub

samwang

§A¦n,¤j¤j,ÁÂÁ§A¦A¦¸À°¦£,¦n¹³®t¤@ÂISheet1 ¬O¸ê®Æ¨Ó·½,
·í§Ú¦bSheet2 ¥´¤WJob ©MLine «á,Sheet2ªº ...
stephenlee µoªí©ó 2022-8-10 13:52

4¼Ó©M6¼Ó»Ý¨D¤£¤Ó¤@¼Ë¡A½Ð¦A½T»{¹ê»Ú»Ý¨D¡AÁÂÁÂ

samwang

§A¦n,¤j¤j,ÁÂÁ§A¦A¦¸À°¦£,¦n¹³®t¤@ÂISheet1 ¬O¸ê®Æ¨Ó·½,
·í§Ú¦bSheet2 ¥´¤WJob ©MLine «á,Sheet2ªº ...
stephenlee µoªí©ó 2022-8-10 13:52

¬O³o¼Ë¶Ü? ½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, xD, T$, br, a1$, a2$, ky, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Sheets(1).Range("a1").CurrentRegion
For i = 2 To UBound(Arr)
    T = Arr(i, 1) & "|" & Arr(i, 2): xD(T) = Arr(i, 3)
Next
With Sheets(2)
    Arr = .Range("a1").CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 1) & "|" & Arr(i, 2)
        If xD.Exists(T) Then
            Arr(i, 3) = xD(T)
        Else
            a1 = Split(Arr(i, 2), "-")(0): a2 = Split(Arr(i, 2), "-")(1)
            For Each ky In xD.keys
                If Split(ky, "|")(0) <> Arr(i, 1) Then GoTo 98
                br = Split(Split(ky, "|")(1), "-")
                If UBound(br) < 1 Then GoTo 98
                If br(0) <= a1 And br(1) >= a2 Then Arr(i, 3) = xD(ky)
98:         Next
        End If
    Next
    .[a1].Resize(UBound(Arr), 3) = Arr
End With
End Sub