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

074063

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

¤U¸ü (173.98 KB)

2016-1-5 01:02

Book1.rar (9.08 KB)

¤U¸ü¦¸¼Æ: 7

2016-1-5 01:02

GBKEE

¦^´_ 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

yen956

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

074063

¦^´_ 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ªº®É¶¡

¤U¸ü (121.05 KB)

2016-1-10 15:44

GBKEE

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

½Æ»s¥N½X

yen956

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

¤U¸ü (61.15 KB)

2016-1-10 13:43

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

074063

¦^´_ 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....

yen956

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

¤U¸ü (145.26 KB)

2016-1-8 08:48

074063

¦^´_ 11# GBKEE


    ½Æ»s~¶K¤W  Ê¨

GBKEE

¦^´_ 8# 074063
17:20       
~       
19:20       
³o®É¶¡ªºÅÞ¿è¦p¦ó³]©w