Kubi

¦^´_ 1# simontasi
¸g¾ã²z«á¸ê®Æ¶×¥XB:DÄæ¡C

1. Sub test()
   
2.     Dim arr, brr()
   
3.     With ActiveSheet
   
4.         .Cells.Replace ChrB(160), ""
   
5.         er = .[A65536].End(3).Row
   
6.         arr = .Range("A1:A" & er)
   
7.         .[B1:D65536].ClearContents
   
8.     End With
   
9.     n = -1
   
10.     For i = 1 To UBound(arr)
    
11.         If InStr(arr(i, 1), "abc") <> 0 Then
    
12.             n = n + 1
    
13.             ReDim Preserve brr(2, n)
    
14.             brr(0, n) = arr(i, 1)
    
15.             c = 1
    
16.         Else
    
17.             If Right(arr(i, 1), 1) = "¤¸" Then
    
18.                 brr(c, n) = Val(arr(i, 1))
    
19.                 c = c + 1
    
20.             End If
    
21.         End If
    
22.     Next i
    
23.     ActiveSheet.[B1].Resize(n + 1, 3) = Application.Transpose(brr)
    
24. End Sub

½Æ»s¥N½X