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

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

¦^´_ 8# 074063
17:20       
~       
19:20       
³o®É¶¡ªºÅÞ¿è¦p¦ó³]©w
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 11# GBKEE


    ½Æ»s~¶K¤W  Ê¨

TOP

¥»©«³Ì«á¥Ñ yen956 ©ó 2016-1-8 09:00 ½s¿è

Sorry,²×©ó¤F¸Ñ§Aªº»Ý¨D.
¬O¤£¬O³o­Ó·N«ä?¸Õ¸Õ¬Ý:
  1. ' ¥»VBA½Ð©ñ¦bSheet(1), ¤£­n©ñ¦b Module1
  2. ' ½Ð¥ý¤â°Ê½Õ¾ã§A©Ò»Ý­nªº®æ¦¡, ¦A°õ¦æ¥»VBA
  3. ' ©m¦W©ñ¦b [J21:J23](½Ð¥ý½Õ¦n©m¦W®æ¦¡, ¥B©m¦W½ÐªÅ¥Õ)
  4. ' ®É¶¡©ñ¦b [H21:I23](½Ð¥ý½Õ¦n®É¶¡®æ¦¡, ¨Ã¶ñ¤J®É¶¡)
  5. ' ­Y±N©m¦W¡B®É¶¡®æ¦¡§ï§O³B, ¤U¦C¬ÛÃö[¦ì§}]½Ð­×§ï
  6. Sub TESTx()
  7.     Dim dV As Object, d0 As Object, dX As Object, E
  8.     Set dV = CreateObject("Scripting.Dictionary")
  9.     Set d0 = CreateObject("Scripting.Dictionary")
  10.     Set dX = CreateObject("Scripting.Dictionary")
  11.    
  12.     '1. §¹¥þ²M°£¿é¥X°Ï(¥]§t¤º®e¡B®æ¦¡µ¥)
  13.     [H13:BE15].Clear
  14.    
  15.     '2. ÄæBªº©m¦W¤ÀÃþ©ñ¤JDictionary¤¤
  16.        For Each E In Range("B2", "B" & [B65536].End(xlUp).Row)
  17.         If E.Offset(0, 1) = "" Then GoTo Next1:
  18.         If E.Offset(0, 1) = "V" Then dV.Item(E) = "": GoTo Next1:
  19.         If E.Offset(0, 1) = "O" Then d0.Item(E) = "": GoTo Next1:
  20.         If E.Offset(0, 1) = "X" Then dX.Item(E) = ""
  21. Next1:
  22.     Next
  23.    
  24.     '3. ½Æ»s©m¦W®æ¦¡(­««Ø©m¦W®æ¦¡)
  25.     [J21:J23].Copy [H13].Resize(1, dV.Count)
  26.     [J21:J23].Copy [H13].Offset(0, dV.Count + 2).Resize(1, d0.Count)
  27.     [J21:J23].Copy [H13].Offset(0, dV.Count + d0.Count + 4).Resize(1, dX.Count)
  28.    
  29.     '4. ¶}©l¿é¥X©m¦W
  30.     [H13].Resize(1, 40) = ""
  31.     [H13].Resize(1, dV.Count) = dV.Keys
  32.     [H13].Offset(0, dV.Count + 2).Resize(1, d0.Count) = d0.Keys
  33.     [H13].Offset(0, dV.Count + 2 + d0.Count + 2).Resize(1, dX.Count) = dX.Keys
  34.    
  35.     '5. ½Æ»s®É¶¡
  36.     [H21:I23].Copy [H13].Offset(0, dV.Count)
  37.     [H21:I23].Copy [H13].Offset(0, dV.Count + 2 + d0.Count)
  38. End Sub
½Æ»s¥N½X
test.gif

TOP

¦^´_ 13# yen956


    ·PÁÂyen956¤j¤j, ¸Ñµªº¡¦X¥G»Ý¨D

    ¥»¥H¬°µ{§Ç·|«Ü½ÆÂø, ©Ò¥H·Q»¡¦UÃþ§O¤¤¶¡ªÅ2®æ¦A¦Û¦æ°Å¶K¤W¥h

    ¤p§Ì¦³­Ó°ÝÃD, ¦pªG§ÚªºÃþ§O¦³3~4²Õ, «h°Ï¤À®É¶¡¬Ò¤£¦Pªº¸Ü

    ¤ñ¦p¦b¡iO¡jÃþ§O«e®É¶¡¬°17:20~19:20, ¦b¡iX¡jÃþ§O«e®É¶¡¬°17:20~18:20....

TOP

¦^´_ 14# 074063
°²³]¦p¤U¹Ï:

«h
    '5. ½Æ»s®É¶¡
    [H21:I23].Copy [H13].Offset(0, dV.Count)   '®É¶¡¤Î®æ¦¡1 ªº¦ì§}
    [H25:I27].Copy [H13].Offset(0, dV.Count + 2 + d0.Count)   '®É¶¡¤Î®æ¦¡2 ªº¦ì§}

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2016-1-12 05:59 ½s¿è

¦^´_ 14# 074063
¤]¥i¥H¤£¥Î ¦r¨åª«¥ó.
  1. Option Explicit
  2. '*** Ãþ§O¦³ÅÜ°Ê·s¼W©Î´î¤Ö¦b¼Ò²Õ¤WºÝ­×§ï,¤£¥²­×§ï¦¨¦¡½X***
  3. '¦pªG§ÚªºÃþ§O¦³3~4²Õ
  4. Const KeyWord = "VOX"
  5. '«h°Ï¤À®É¶¡¬Ò¦b¡iO¡jÃþ§O«e®É¶¡¬°17:20~19:20, ¦b¡iX¡jÃþ§O«e®É¶¡¬°17:20~18:20....
  6. Const KeyTime = "17:20,~,19:20" & vbLf & "17:20,~,24:20" '& vbLf &......

  7. Dim Rng As Range
  8. Sub Ex_²M°£¸ê®Æ()
  9.     Set Rng = Sheets("sheet1").Range("h7") '¿é¤Jªº¦ì¸m
  10.     With Rng.CurrentRegion
  11.         If Application.CountA(.Cells) > 0 Then .Clear
  12.     End With
  13. End Sub
  14. Sub Ex_¸ê®Æ¿é¤J()
  15.     Dim Ar(0 To Len(KeyWord) - 1), i As Integer, R As Integer, E As Integer, Ar_Time As Variant
  16.     Dim C As Integer
  17.     Ex_²M°£¸ê®Æ
  18.     Ar_Time = Split(KeyTime, vbLf)  'KeyTime¦r¦ê¤À³Î¬°°}¦C
  19.     Application.ScreenUpdating = False
  20.     i = 2
  21.     Do
  22.         R = InStr(KeyWord, Rng.Parent.Cells(i, "C"))  '³ÆµùÄ檺¦r¦ê,¦bKeyWord¤¤ªº¶¶§Ç
  23.         If Rng.Parent.Cells(i, "C") <> "" And R >= 1 Then
  24.             Ar(R - 1) = Ar(R - 1) & Rng.Parent.Cells(i, "B") & vbLf
  25.             '¨Ì KeyWordªº¦r¥À¶¶§Ç ±N©m¦WÄ檺¸ê®Æ,¾É¤JAr¤¤
  26.         End If
  27.         i = i + 1
  28.     Loop Until Rng.Parent.Cells(i, "b") = ""  'BÄæ¨S¦³¸ê®Æ
  29.     '******©m¦WÄ檺¸ê®Æ,¾É¤JAr¤¤ §¹²¦****
  30.     i = 0
  31.     For R = 0 To UBound(Ar)
  32.         Ar(R) = Split(Ar(R), vbLf)  '¾É¤JAr¤¤©m¦WÄæ¸ê®Æ,¤À³Î¬°°}¦C
  33.         For C = 0 To UBound(Ar(R)) - 1
  34.             With Rng.Offset(, i).Resize(3)
  35.                 .MergeCells = True
  36.                 .Orientation = xlVertical
  37.                 .Value = Ar(R)(C)
  38.             End With
  39.             i = i + 1
  40.         Next
  41.         If R < UBound(Ar) Then
  42.         For E = 1 To 3
  43.             With Rng.Offset(, i).Resize(, 2).Rows(E)
  44.                 .MergeCells = True
  45.                 .HorizontalAlignment = xlCenter
  46.                 .Value = "'" & Split(Ar_Time(R), ",")(E - 1)
  47.                 '°}¦C Ar_Time
  48.             End With
  49.         Next
  50.         End If
  51.         i = i + 2
  52.     Next
  53.     With Rng.CurrentRegion.Font
  54.         .Bold = True
  55.         .ColorIndex = 25
  56.     End With
  57.     Application.ScreenUpdating = True
  58. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¥»©«³Ì«á¥Ñ 074063 ©ó 2016-1-10 15:44 ½s¿è

¦^´_ 16# GBKEE


    °²¦pÃþ§O¨Ì§Ç¦³¡iV¡j¡iO¡j¡iX¡j,  ¤µ¤ékey in®É¥u¦³¡iV¡j¡iX¡j2Ãþ, ¦Ó¡iO¡j±q¯Ê

    ¦bµ{¦¡½X¤º¬O§_¯à§PÂ_¤£­n¿é¥X¡iO¡jÃþ§Oªº®É¶¡

TOP

  1. ' ¥»VBA½Ð©ñ¦bSheet(1), ¤£­n©ñ¦b Module1
  2. ' ¤U¦C¨â¦C ******** ¤§¶¡½Ð¥ý½Õ½Õ¦n, ¦A°õ¦æ¥»VBA
  3. Sub TEST3()
  4.     Dim I As Integer, J As Integer, Col As Integer
  5.     Dim arST, arET, arKind
  6.     ''***********************
  7.     Dim ndx(10) As Integer, cnt(10) As Integer          '¦h¼g¤@ÂI³Æ¥Î, ¨S¥Î¨ì¤]¨SÃö«Y
  8.     arKind = Array("X", "O", "V", "¡·", "¡¯")                  '¥i¼W´î, ¨S¥Î¨ì¤]¨SÃö«Y
  9.     '²Å¸¹±Æ¦C¶¶§Ç, »P±N¨Óªº¿é¥X¶¶¦³Ãö
  10.     arST = Array("17:20", "17:21", "17:22", "17:23")    '°_©l®É¶¡, ³Ì¦h¥u¯à¤ñ"V,O,X,¡·,¡¯"¤Ö1
  11.     arET = Array("19:20", "19:21", "19:22", "19:23")    'µ²§ô®É¶¡, ³Ì¦h¥u¯à¤ñ"V,O,X,¡·,¡¯"¤Ö1
  12.     ''***********************
  13.     Col = 8      'H=8, ©m¦W¿é¥X¦ì¸m¦b [H13]
  14.    
  15.     '1. §¹¥þ²M°£¿é¥X°Ï(¥]§t¤º®e¡B®æ¦¡µ¥)
  16.     [H12:IV15].Clear
  17.    
  18.     '2. ­««Ø®É¶¡
  19.     For I = 0 To UBound(arKind) - 1
  20.         cnt(I) = Application.CountIf(Range("C2", "C" & [C65536].End(xlUp).Row), arKind(I))
  21.         If cnt(I) > 0 Then
  22.             ndx(I) = Col
  23.             Col = Col + cnt(I)
  24.             If I <> UBound(arKind) - 2 Then
  25.                 For J = 13 To 15
  26.                     Cells(J, Col).Resize(1, 2).Merge   '®É¶¡®æ¦X¨Ö
  27.                     Cells(J, Col).HorizontalAlignment = xlCenter
  28.                 Next
  29.                 Cells(13, Col) = arST(I)            '°_©l®É¶¡¦b²Ä13¦C
  30.                 Cells(14, Col) = "~"                '"~" ¸¹¦b²Ä14¦C
  31.                 Cells(14, Col).Orientation = -90    '¤å¦r¤è¦V¡÷¥kÂà90«×(¿ý¨Óªº)
  32.                 Cells(15, Col) = arET(I)            'µ²§ô®É¶¡¦b²Ä15¦C
  33.                 '¦p»Ý¨ä¥L®æ¦¡, ½Ð¦Û¦æ¿ý»s¦A¿ï¥Î¶K¤W(µL¶·¥þ³¡·Ó§Û)
  34.             End If
  35.             Col = Col + 2
  36.         End If
  37.     Next
  38.    
  39.     '3. ¶}©l¿é¥X©m¦W
  40.     For Each E In Range("B2", "B" & [B65536].End(xlUp).Row)
  41.         If E.Offset(0, 1) = "" Then GoTo Next1:
  42.         For I = 0 To UBound(arKind) - 1
  43.             If E.Offset(0, 1) = arKind(I) Then
  44.                 Cells(12, ndx(I)) = arKind(I)    'Åã¥Ü¼Ð°O(¦]¦³¨Ç²Å¸¹§A¤£·Q¥Î, ¬G¥[µù¤~·|²M·¡), ¥iµù¸Ñ±¼
  45.                 Cells(13, ndx(I)) = E
  46.                 Cells(13, ndx(I)).Resize(3, 1).Merge  '©m¦W®æ¦X¨Ö
  47.                 Cells(13, ndx(I)).Orientation = xlVertical   '¤å¦r¤è¦V¡÷««ª½±Æ¦C
  48.                 ndx(I) = ndx(I) + 1
  49.                 GoTo Next1:
  50.             End If
  51.         Next
  52. Next1:
  53.     Next
  54. End Sub
½Æ»s¥N½X
¦^´_ 17# 074063

TOP

¦^´_ 17# 074063

16# ªºµ{¦¡½X ¥i­×§ï
  1.    '******©m¦WÄ檺¸ê®Æ,¾É¤JAr¤¤ §¹²¦****
  2.     i = 0
  3.     For R = 0 To UBound(Ar)
  4.         If Ar(R) <> "" Then
  5.             Ar(R) = Split(Ar(R), vbLf)  '¾É¤JAr¤¤©m¦WÄæ¸ê®Æ,¤À³Î¬°°}¦C
  6.             For C = 0 To UBound(Ar(R)) - 1
  7.                 With Rng.Offset(, i).Resize(3)
  8.                     .MergeCells = True
  9.                     .Orientation = xlVertical
  10.                     .Value = Ar(R)(C)
  11.                 End With
  12.                 i = i + 1
  13.             Next
  14.         End If
  15.         If R < UBound(Ar) Then
  16.             For E = 1 To 3
  17.                 With Rng.Offset(, i).Resize(, 2).Rows(E)
  18.                     .MergeCells = True
  19.                     .HorizontalAlignment = xlCenter
  20.                     .Value = "'" & Split(Ar_Time(R), ",")(E - 1)
  21.                     '°}¦C Ar_Time
  22.                 End With
  23.             Next
  24.         End If
  25.         i = i + 2
  26.     Next
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : §ïÅܦۤv¬O¦Û±Ï¡A¼vÅT§O¤H¬O±Ï¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD