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

[¦r¨åª«¥ó]³æ¤@Äæ¦ìªº­È»P¦h­Ó°}¦C¤ñ¹ï«á¨Ã¤ÀÃþ¦Ü¤£¦PÄæ¦ì

¦^´_ 3# greetingsfromtw
¤£¥Î¦r¨åª«¥ó¤]¥i¥H¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, R As Range, E As Range, i(1 To 2) As Integer
  4.     With Range("J1").CurrentRegion
  5.         i(1) = .Columns.Count + 1
  6.         Set Rng = .Rows("2:" & .Rows.Count).SpecialCells(xlCellTypeConstants)  '¤ñ¹ï¦r¦ê
  7.     End With
  8.     Range([A2], [A2].End(xlDown)).Offset(, 1).Resize(, i(1)) = ""
  9.     For Each R In Range([A2], [A2].End(xlDown)) '­ì©l¸ê®Æ°j°é
  10.             i(2) = i(1)
  11.             For Each E In Rng
  12.                 If InStr(UCase(R), UCase(E)) Then
  13.                     i(2) = E.Column - Range("J1").Column + 1
  14.                     Exit For
  15.                 End If
  16.             Next
  17.           With Cells(65536, 1 + i(2))
  18.             If .EntireColumn.Find(R, Lookat:=xlPart) Is Nothing Then .End(xlUp).Offset(1) = R
  19.             '¸ê®Æ¤£­«½Æ
  20.           End With
  21.     Next
  22. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 3# greetingsfromtw
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Set Rng = Range("J1").CurrentRegion.SpecialCells(xlCellTypeConstants) '¤ñ¹ï°}¦C
  4. For Each a In Range([A2], [A2].End(xlDown)) '­ì©l¸ê®Æ°j°é
  5.   For Each c In Rng
  6.      If InStr(UCase(a), UCase(c)) > 0 Then
  7.         d(c.Column) = "" '°O¦í¤ñ¹ï¨ì°}¦CªºÄæ¦ì
  8.      End If
  9.   Next
  10.   If d.Count > 0 Then 'ªí¥Ü­ì©l¸ê®Æ¤ñ¹ï¦¨¥\
  11.      For Each ky In d.keys
  12.        Cells(65536, ky - 8).End(xlUp).Offset(1, 0) = a
  13.      Next
  14.      d.RemoveAll '²MªÅ¦r¨å
  15.      Else
  16.      Cells(65536, "E").End(xlUp).Offset(1, 0) = a '¤ñ¹ï¤£¦¨¥\
  17.   End If
  18. Next
  19. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 2# ­ã´£³¡ªL

«D±`·PÁ²a´£³¡ªL«e½ú´£¨Ñ¸Ñµª,¤ñ­ì¥»ªºµ{¦¡½XÁY´î«Ü¦h,¤p§Ì¹ÄªA.
¥Ø«eÁÙ¦b§V¤OÆp¬ã¦r¨åª«¥ó¤¤,
¤@©w§V¤O¾Ç²ß,
§Æ±æ¦³´Â¤@¤é¯à¤Î±o¤W«e½úªº¸U¤À¤§¤@.

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2016-10-20 16:43 ½s¿è
  1. Sub U_Test()
  2. Dim xR As Range, xD, Arr, Brr, Mx&, N%, G(1 To 4), DK
  3. Arr = Range([A2], Cells(Rows.Count, 1).End(xlUp))
  4. Set xD = CreateObject("Scripting.Dictionary")
  5. For Each xR In [J2:L40]
  6.     If xR <> "" Then xD(UCase(xR)) = xR.Column - 9 'ÃöÁä¦r¨Ì¨äÄæ¦ì±a§Ç¸¹
  7. Next
  8. ReDim Brr(1 To UBound(Arr), 1 To 4)

  9. For i = 1 To UBound(Arr)
  10.     N = 4 '¹w³]§Ç¸¹¬°4
  11.     For Each DK In xD.keys
  12.         If InStr(UCase(Arr(i, 1)), DK) Then N = xD(DK): Exit For '¦³²Å¦X,¨ú¥X§Ç¸¹
  13.     Next
  14.     G(N) = G(N) + 1 '¨Ì§Ç¸¹¤£¦P, ¦U¦Û²Ö­pÄæ¦ìªºµ§¼Æ
  15.     If G(N) > Mx Then Mx = G(N) '¨ú±o³Ì¤jµ§¼Æ
  16.     Brr(G(N), N) = Arr(i, 1) '«ö§Ç¸¹¤Îµ§¼Æ¶ñ¤J¸ê®Æ¨ì°}¦C
  17. Next i
  18. [B2].Resize(Mx, 4) = Brr
  19. End Sub
½Æ»s¥N½X


InStr ·|°Ï¤À­^¤å¤j¤p¼g, ¥²¶·¨Ï¥Î UCase ²Î¤@Âର¤j¼g(LCase¤]¥i)

TOP

        ÀR«ä¦Û¦b : ¡i¦æµ½­n¤Î®É¡j¦æµ½­n¤Î®É¡A¥\¼w­n«ùÄò¡C¦p¿N¶}¤ô¤@¯ë¡A¥¼¿N¶}¤§«e¤d¸U¤£­n°±º¶¤õ­Ô¡A§_«h­«¨Ó´N¤Ó¶O¨Æ¤F¡C
ªð¦^¦Cªí ¤W¤@¥DÃD