ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] Excel ¦X¨Ö¹ïÀ³¸ê®Æ

[µo°Ý] Excel ¦X¨Ö¹ïÀ³¸ê®Æ

¦Û°Ê¦X¨Ö¸ê®Æ©Ò»Ý

Sheet1 AÄæ¤ÎBÄæ¬O¸ê®Æ¨Ó·½

¦ÓSheet2 AÄæ·í§Ú»Ý­n¥´¤Wjob ®É,BÄ檺Po­n¦Û°Ê´M§ä³Q¦X¨Öªº¤º®e¨Ó²Õ¦XPo

BÄæ­n¥Î¤½¦¡©ÎªÌVBA °µ,¦ý¤@¯ë B2Äæ³o¨Ç¬O¥i¥H¥Îvlookupª½±µ¨ú±oSheet1 BÄ檺¸ê®Æ,¦ý¬O¦pªG¹³
Sheet2 AÄæ³Q²Õ¦X¤F(05-06) ³o¼Ë«hµLªk¥Îvlookup ±N¥L¦X¨Ö,¦p¦ó¨ú¬A¸¹¤ºªº¸ê®Æ¨Ó¹ïÀ³¨úSheet1¤ºªºPoÄæ¸ê®Æ¨ìSheet2 ¤ºªºPoÄ椺,¥Î "/" ¨Ó¤À¿ë¤£¦PªºPo¡C µ²ªG¹³SHeet2 ªº¤@¼Ë,¦p¦ó¥ÎVBA©Î¤½¦¡°µ¨ì¡CÁÂÁÂ

¦X¨Ö.rar (6.92 KB)

¦^´_ 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

TOP

ÀH·NºÛ "EXCEL°g"  blog  ©Îhttps://hcm19522.blogspot.com/ EXCEL¨ç¼Æ

TOP

¦^´_  stephenlee

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, xD, T$, br, a1$, a2$, ky, i&
Set xD = C ...
samwang µoªí©ó 2022-8-7 07:53



    §A¦n,¤j¤j

ÁÂÁ»դUªá¤F³o»ò¦h®É¶¡À°§Ú»s§@¤F³o­ÓVBA, ³o­ÓVBA §¹¥þ²Å¦X§Úªº­n¨D,«D±`·PÁÂ,¤j¤j«Ü±j¡C
¦b¦¹¤£¦n·N«ä¬Ý»Õ¤U¬O§_¯àÀ°§Ú¦A¬Ý¤@¤U,·sªº­n¨D,³o¦¸ªº­n¨D¬O­n®Ú¾Ú job ©Mline ¨Ó¨úSHeet2 ªºPo¡C



¦X¨Ö v2.rar (7.61 KB)

TOP

§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

TOP

½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, xD, T$, i&
Set xD = CreateObject("Scripting.Dictionary ...
samwang µoªí©ó 2022-8-9 09:34



§A¦n,¤j¤j,ÁÂÁ§A¦A¦¸À°¦£,¦n¹³®t¤@ÂISheet1 ¬O¸ê®Æ¨Ó·½,
·í§Ú¦bSheet2 ¥´¤WJob ©MLine «á,Sheet2ªºPoÄæ·|¦Û°Ê®Ú¾ÚJob ©MLine¨Ó¨úSheet1 ªºPo¸ê®Æ, ¨C¦¸¸ê®Æ³£·|ÅÜ°Ê,©Ò¥H­n®Ú¾ÚLine¤ºªº­S³ò¨Ó¨úSHeet1ªºPo,

¨Ò¦p SHeet1 ªºjob ¬O
WEC-20-01     1-5        5241-MC

WEC-20-01      6-7      5242-KOL


¨Ò¦p§Ú¦bSHeet2 ¥´¤W
WEC-20-01    1-2  
WEC-20-01    3-5
WEC-20-01    6
WEC-20-01     7

¥Ñ©óLine¦b­S³ò¤º©Ò¥Hµ²ªG¬°


WEC-20-01    1-2     5241-MC
WEC-20-01    3-5      5241-MC
WEC-20-01    6           5242-KOL
WEC-20-01     7          5242-KOL

¤S¦A³Â·Ð§A¬Ý¬Ý¯à¤£¯à¦A§Ë¤@¤U,·P¿E¡C



¦X¨Ö v2.rar (7.61 KB)

TOP

§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ÁÂÁÂ
1.JPG

TOP

§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

TOP

¬O³o¼Ë¶Ü? ½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, xD, T$, br, a1$, a2$, ky, i&
Set xD = CreateOb ...
samwang µoªí©ó 2022-8-11 07:49



  ¨S¿ù¤F,¬O³o¼Ë¡C

¤£¦n·N«ä«e­±¥i¯à»¡±o¤£¤Ó²M·¡¡C²{¦b¤wº¡¨¬¤F§Úªº¤u§@»Ý¨D¤F¡C

«D±`·PÁ¤j¤jªºÀ°¦£ªá¤F³o»òªøªº®É¶¡À°§Ú¬ã¨s,«D±`·PÁ¡C
§A¯uªº«ÜÀy®`¡C¦b¦¹¸÷Á¤F¡C

TOP

        ÀR«ä¦Û¦b : ¨Ã«D¦³¿ú¾{¬O§Ö¼Ö¡A°Ý¤ßµL·\¤ß³Ì¦w¡C
ªð¦^¦Cªí ¤W¤@¥DÃD