ikboy

§R¥h¤½¦¡,¨Ï¥ÎVBA·|§ó§Ö¡G

1. Sub zz()
   
2. Dim a, d As Object, b(), n&
   
3. a = Sheets(1).Range("a2:d" & Sheets(1).[a1048576].End(3).Row)
   
4. Set d = CreateObject("scripting.dictionary")
   
5. With CreateObject("vbscript.regexp")
   
6.     .Pattern = "-\w$"
   
7.     For i = 1 To UBound(a)
   
8.         If Len(a(i, 3)) = 0 Then a(i, 3) = a(i, 1)
   
9.         k = a(i, 3)
   
10.         a(i, 3) = .Replace(k, "")
    
11.         d(a(i, 3)) = ""
    
12.     Next
    
13.     k = Join(d.keys, "|")
    
14.     .Pattern = k
    
15.     a = Sheets(2).[a1].CurrentRegion
    
16.     ReDim b(1 To UBound(a), 1 To UBound(a, 2))
    
17.     For i = 2 To UBound(a)
    
18.         If Len(a(i, 3)) > 0 Then k = a(i, 3) Else k = a(i, 1)
    
19.         If .test(k) Then
    
20.              n = n + 1
    
21.              For j = 1 To UBound(a, 2)
    
22.                 b(n, j) = a(i, j)
    
23.              Next
    
24.         End If
    
25.     Next
    
26.     Sheets(3).[a1].CurrentRegion.Offset(1).Clear
    
27.     Sheets(3).[a2].Resize(n, 4) = b
    
28. End With
    
29. End Sub

½Æ»s¥N½X

ikboy

¦^´_ 9# qaqa3296

1. Sub zz()
   
2. Dim a, d As Object, b, n&
   
3. a = Sheets(1).Range("a2:d" & Sheets(1).[a1048576].End(3).Row)
   
4. Set d = CreateObject("scripting.dictionary")
   
5. With CreateObject("vbscript.regexp")
   
6.     .Pattern = "[-\.\s]+"
   
7.     .Global = True
   
8.     For i = 1 To UBound(a)
   
9.         If Len(a(i, 3)) = 0 Then a(i, 3) = Trim(a(i, 1))
   
10.         a(i, 3) = Trim(a(i, 3))
    
11.         k = Split(.Replace(a(i, 3), "|"), "|")
    
12.         If UBound(k) > 0 Then k = k(0) & "-" & k(1) Else k = a(i, 3)
    
13.         d(k) = ""
    
14.     Next
    
15.     k = Join(d.keys, "|")
    
16.     .Pattern = k
    
17.     a = Sheets(2).[a1].CurrentRegion
    
18.     b = a: n = 1
    
19.     For i = 2 To UBound(a)
    
20.         If Len(a(i, 3)) > 0 Then k = a(i, 3) Else k = a(i, 1)
    
21.         If .TEST(k) Then
    
22.              n = n + 1
    
23.              For j = 1 To UBound(a, 2)
    
24.                 b(n, j) = a(i, j)
    
25.              Next
    
26.         End If
    
27.     Next
    
28.     Workbooks.Add 1
    
29.     [a1].Resize(n, 4) = b
    
30. End With
    
31. End Sub

½Æ»s¥N½X