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

¦p¦ó°Ñ·Ó¸ê®Æ±N¤Ä¿ï¶µ«ü©w¦Ü½d³òÀx¦s®æ

¦p¦ó°Ñ·Ó¸ê®Æ±N¤Ä¿ï¶µ«ü©w¦Ü½d³òÀx¦s®æ

¦pªþ¥ó, ½Ð±Ð¦U¦ì¤j¤j

Book1.rar (9.08 KB)

¦^´_ 1# 074063
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D As Object, i As Integer, Ar(), E As Variant
  4.     Set D = CreateObject("SCRIPTING.DICTIONARY")  '¦r¨åª«¥ó
  5.     i = 2
  6.     Do While Range("B" & i) <> ""  'B2¶}©lª½¨ìBÄæ¨S¸ê®Æ
  7.         If Range("C" & i) <> "" Then
  8.             If Not D.exists(Range("C" & i).Text) Then  '¦r¨åª«¥óªºkey¤£¦s¦b
  9.                 D(Range("C" & i).Text) = Array(Range("b" & i)) '³oªºkeyªº¶µ¥Ø¬°..
  10.             Else  '¦r¨åª«¥óªºkey¤w¦s¦b
  11.                 Ar = D(Range("C" & i).Text)         'Ar=¦r¨åª«¥óªºkeyªº¶µ¥Ø
  12.                 ReDim Preserve Ar(UBound(Ar) + 1)   '°}¦CÂX¥R¤@¤¸¯À
  13.                 Ar(UBound(Ar)) = Range("b" & i)     '°}¦C³Ì«á¤¸¯Àªº­È
  14.                 D(Range("C" & i).Text) = Ar         '¦r¨åª«¥óªºkeyªº¶µ¥Ø=Ar
  15.             End If
  16.         End If
  17.         i = i + 1
  18.     Loop
  19.     i = 1
  20.     With Range("E4")
  21.         For Each E In D.ITEMS      '¦r¨åª«¥óªº¶µ¥Ø
  22.             .Cells(1, i).Resize(1, UBound(E) + 1) = E
  23.             i = i + UBound(E) + 3
  24.         Next
  25.     End With
  26. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¥t­Ó°Ñ¦Ò¡G

Sub TEST()
Dim xD, T, TT, xR As Range
Set xD = CreateObject("Scripting.Dictionary")
For Each xR In Range([B2], [B65536].End(xlUp))
¡@¡@T = xR(1, 2): If T <> "" Then xD(T) = xD(T) & "|" & xR
Next
¡@
Set xR = [E4]: xR.Resize(1, 100) = ""
For Each T In Array("V", "O", "X")
¡@¡@If xD(T) = "" Then GoTo 101
¡@¡@TT = Split(Mid(xD(T), 2), "|")
¡@¡@xR.Resize(1, UBound(TT) + 1) = TT
¡@¡@Set xR = xR(1, UBound(TT) + 4)
101: Next
End Sub

TOP

http://blog.xuite.net/hcm19522/twblog/371048822

TOP

¥»©«³Ì«á¥Ñ yen956 ©ó 2016-1-5 15:22 ½s¿è

§Ú¤]¸Õ¸Õ¬Ý:
  1. Sub TEST1()
  2.     Dim dv As Object, d0 As Object, dx As Object, E
  3.     Set dv = CreateObject("Scripting.Dictionary")
  4.     Set d0 = CreateObject("Scripting.Dictionary")
  5.     Set dx = CreateObject("Scripting.Dictionary")
  6.     For Each E In Range([B2], [B65536].End(xlUp))
  7.         If E.Offset(0, 1) = "V" Then dv.Item(E) = ""
  8.         If E.Offset(0, 1) = "O" Then d0.Item(E) = ""
  9.         If E.Offset(0, 1) = "X" Then dx.Item(E) = ""
  10.     Next
  11.     [E4].Resize(1, 40) = ""
  12.     [E4].Resize(1, dv.Count) = dv.Keys
  13.     [E4].Offset(0, dv.Count + 2).Resize(1, d0.Count) = d0.Keys
  14.     [E4].Offset(0, dv.Count + 2 + d0.Count + 2).Resize(1, dx.Count) = dx.Keys
  15. End Sub
½Æ»s¥N½X

TOP

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


    ·PÁ¦U¦ì¤j¤jªº¸Ñµª, ^^

    ¤p§Ì¥t½Ð±Ð¦p¦ó§â E4:AG4 ¸ê®Æ²MªÅ, ¨Ã¨CÄæ3¦C¦X¨Ö¦¨¤@®æÀx¦s®æ, ¥B³£µL®Ø½u

TOP

¦^´_ 6# 074063
Sub test()
    Dim I As Integer, J As Integer
    For I = 5 To 33
        Cells(4, I).Resize(3, 1).Select
        With Selection
            .Merge
            For J = 1 To 4
                .Borders(J).LineStyle = xlNone
            Next
        End With
    Next
End Sub

TOP

¦^´_ 7# yen956


    ÁÂyen956¤j¤j¸Ñµª, °õ¦æ°_¨Ó¦n¹³¥d¥dªº

    ·PÁÂGBKEE¡B­ã´£³¡ªL¡Bhcm19522¡Byen956

    ¦Aªþ¤WÀɮפj¤j­ÌÀ°¦£..

    Book2.rar (28.13 KB)

TOP

¥»©«³Ì«á¥Ñ yen956 ©ó 2016-1-6 12:14 ½s¿è

¦^´_ 8# 074063
Book2 ªº¿é¥X½d³ò»PBook1 ªº¿é¥X½d³ò¤£¦P,
­ì VAB ­n®M¥Î¨ì Book2 ¤W, ½Ð±N¬ÛÃö¦ì§}§ï¤@§ï,
(¤£½×¬O¤½¦¡©Î¬OVBA§¡¦p¦¹)
¥H 5#F §ÚªºVBA¬°¨Ò, ¥u­n±N
[E4] §ï¬° [H13], §Y¥i¥¿±`

¤S, ¿é¥X¥Øªº¦aªº®æ¦¡©y«O«ù¤@­P, ¤¤¶¡¤S´¡¤J®É¶¡µ¥®æ¦¡,
·|³y¦¨¾ã­Óªí®æ¨S¦³¼u©Ê, ¤£¯à¼W¥[©Î´î¤Ö¦U²Õ¦W³æªº½Õ¾ã.
ªí®æ¶V²³æ¶V¦n³B²z

TOP

Sub ²M°£()
With Range("H13:H15")
¡@¡@¡@.UnMerge
¡@¡@¡@.ClearContents
¡@¡@¡@.Borders.LineStyle = xlNone
¡@¡@¡@.Merge
¡@¡@¡@.Copy Range("I13:AJ15")
End With
End Sub

¥u¯à«Øij¥H¡e«ö¶s¡f°õ¦æ¡A¤£­n¦k¥Îchange¨Æ¥ó¡A³y¦¨ÀÉ®×¾Þ§@ªº§xÂZ©Î®Ä²v¡I¡I¡I

TOP

        ÀR«ä¦Û¦b : ¤£©È¨Æ¦h¡A¥u©È¦h¨Æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD