- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW°ò¶©
- µù¥U®É¶¡
- 2010-5-1
- ³Ì«áµn¿ý
- 2022-1-23
|
¦^´_ 57# iceandy6150 - Option Explicit
- Sub Ex()
- Dim xlMon As Integer, xlYear As String, A As Variant, E As Variant, Ay As String
- Dim Rng(1 To 2) As Range, Rng_Ar(), Ar(), i As Integer, Sh As Variant, X As Integer
- ReDim Ar(1 To Sheets.Count) '°}¦C:¤¸¯À¼Æ = Sheets.Count
- For i = 1 To Sheets.Count
- Ar(i) = Sheets(i).Name '°}¦C:¤¸¯À¾É¤J Sheets.Name
- Next
- With Sheets("·l¯qªí")
- xlYear = Mid(.[a3], InStrRev(.[a3], "¦Ü") + 1, InStrRev(.[a3], "¦~") - InStrRev(.[a3], "¦Ü"))
- 'xlYear : ·l¯qªíªº¦~«×
- xlMon = Mid(.[a3], InStrRev(.[a3], "¦~") + 1, InStrRev(.[a3], "¤ë") - InStrRev(.[a3], "¦~") - 1)
- 'xlMon : ·l¯qªíªº¤ë¥÷
- Set Rng(1) = .[A6,A8,A9,A11,A18:A32,A35:A37]
- ''6Ó½d³ò: ¾P³f¦¬¤J,¶i³f,´Á¥½¦s³f,´î¡G´Á¥½¦s³f,¤ä¥X,¦¬¤J ****
- End With
- For Each A In Rng(1).Areas 'Areas ÄÝ©Ê ¶Ç¦^ Areas ¶°¦X¡A¦¹¶°¦X¥Nªí¦h«½d³ò¤¤ªº©Ò¦³½d³ò¡C°ßŪ
- If InStr(A.Cells(1), "¦s³f") Then Ay = "¦s³f" Else Ay = ""
- '¨Ò¥~³]©w: ´Áªì¦s³f,´Á¥½¦s³f,ªº¤u§@ªí¬O"¦s³f??_??"
- ReDim Rng_Ar(1 To A.Count) '°}¦C:¤¸¯À¼Æ = ¶O¥Î¶µ¥Ø¼Æ
- For i = 1 To A.Count
- Sh = Filter(Ar, IIf(Ay = "", Trim(A.Cells(i)), Ay), True)
- If A.Cells(i) = "" Then Sh = Array() '¨¾§b
- 'Filter ¨ç¼Æ ¶Ç¦^¤@Ó±q¹s¶}©lªº°}¦C¡A¸Ó°}¦C¥]§t°ò©ó«ü©w¿z¿ï·Ç«hªº¤@Ó¦r¦ê°}¦Cªº¤l¶°¡C
- For Each E In Sh
- With Sheets(E) '¦³"¶O¥Î¶µ¥Ø"¦WºÙªº ¤u§@ªí
- Set Rng(2) = .[A:B].Find(xlYear, lookat:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByRows) '®Ö¹ï¦~«×
- If Not Rng(2) Is Nothing Then Set Rng(2) = .[a:a].Find(xlMon, lookat:=xlWhole) '·j´M¤ë¥÷
- If Not Rng(2) Is Nothing Then
- X = 1
- Do
- If Rng(2).Offset(X).Row > .Cells(.Rows.Count, "D").End(xlUp).Row Then Exit Do
- If Rng(2).Offset(X) <> Rng(2) And Rng(2).Offset(X) <> "" Then Exit Do
- X = X + 1
- Loop
- 'Rng(2).Resize(X, 9) : ¤ë¥÷ªº½d³ò
- If InStr(E, "¦¬¤J") Then
- Set Rng(2) = Rng(2).Resize(X, 9).Find("¥»¤ë¦Xp", lookat:=xlPart) '·j´M¥»¤ë¦Xp
- If Not Rng(2) Is Nothing Then Rng_Ar(i) = Rng_Ar(i) + Rng(2).Range("D1")
- '¶U ¤è 'Range("D1")ª÷ÃB¦ì¸m:¥»¤ë¦Xpªº²Ä4Äæ
- Else
- If Trim(A.Cells(i)) = "´î¡G´Á¥½¦s³f" Then
- With Rng(2).Resize(X, 9)
- Rng_Ar(i) = Rng_Ar(i) + .Cells(.Rows.Count, 6)
- 'ɤè:·í¤ë¥÷<¦s³f5-6>ªºFÄ檺.End(xlDown) :"³Ì«á¤@®æ "
- End With
- Else
- Set Rng(2) = Rng(2).Resize(X, 9).Find("¥»¤ë¦Xp", lookat:=xlPart) '·j´M¥»¤ë¦Xp
- If Not Rng(2) Is Nothing Then Rng_Ar(i) = Rng_Ar(i) + Rng(2).Range("C1")
- 'ɤè 'Range("C1")ª÷ÃB¦ì¸m:¥»¤ë¦Xpªº²Ä3Äæ
- End If
- End If
- End If
-
- End With
- Next
- Next
- A.Offset(, IIf(Trim(A.Cells(1)) = "¾P³f¦¬¤J", 2, 1)) = Application.WorksheetFunction.Transpose(Rng_Ar)
- 'Transpose(Âà¸m) : ¤@ºû°}¦C(¾î¦¡) Âà´«¬° ¤Gºû°}¦C(³o¸ÌÅܤ@¦Cª½¦¡)
- Next
- End Sub
½Æ»s¥N½X |
|