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

[µo°Ý] ½Ð°ÝVBA¦p¦ó°j°é¿ï¨ú¤w¿z¿ïªº¸ê®Æ½Æ»s¨ì·s¤u§@ªí¤Wªº¯S©w½d³ò

[µo°Ý] ½Ð°ÝVBA¦p¦ó°j°é¿ï¨ú¤w¿z¿ïªº¸ê®Æ½Æ»s¨ì·s¤u§@ªí¤Wªº¯S©w½d³ò

¦pÃD, §Ú·Q¨Ï¥ÎVBA¥h°j°é¿ï¨ú¤w¿z¿ïªº¸ê®Æ½Æ»s¨ì·s¤u§@ªí¤Wªº¯S©w½d³ò¤Î¦Û°Ê¶}·s¤@¦æ¡C
§Ú¹Á¸Õ¿ý»s¤F¥¨¶°¤Î­×§ï¤F¤Ö³\,¦ý¤£¦¨¥\¡C

VBAªº ¨BÆJ:
    1.«ö¤U¦bSHEET ¡§VBA¡¨ ¤Wªº In out record 7 days«ö§á
    2.·í«ö¤U¨î«á,·|¿ï¾ÜSHEET ¡§AT¡¨
    3.¦bSHEET¡¨AT¡¨¤W, ¥ÑA6©Ô¨ìAD6, ¤§«á«ö¿z¿ï
    4.¤§«á¦bF6¶i¦æ¤é´Á¿z¿ï,
    5.§âSHEET ¡§In out record¡¨ ½Æ»s¤@±i·sSHEET ¥s ¡§In out record 2¡¨
    6.§â¡¨In out record 2¡¨½Æ»s¤@±i·sSHEET¥s¡¨In out record_AT¡¨
    7.§â­è¤~¦bSHEET ¡§AT¡¨¤W¿z¿ï±o¥Xªº¸ê®Æ½Æ»s
    8.¦bSHEET ¡¨In out record_AT¡¨ set C12 ªºVALUE ¬OAT
    9.¦bSHEET¡¨ In out record_AT¡¨ ªºB17 ¶K¤W­è¤~©Ò½Æ»sªº¸ê®Æ,¨C½Æ»s¤@¦¸,¶}·s¤@¦æ,  ¦b·s¤@¦æ¤WÄ~Äò½Æ»s¤Î¤£°÷¦ì¦Û°ÊINSERT·s¤@¦æ
    ­«½Æ¨BÆJ4¦Ü8, °µ7¦¸(¤µ¤é«e3¤Ñ¨ì¤µ¤é«á3¤Ñ,¦@7¤Ñ)

§Ú²{¦b°µ¨ì¤F1¦Ü8,¦ý¨BÆJ9°µ¤F¤@¦¸ÁÙ¥i¥H,¤§«á¦A½Æ»s´N·|Âл\¤§«eªº¸ê®Æ
½Ð°Ý¦p¦ó­×§ï? ³Â·Ð«ü¾É¡A·PÁ¡C

Code:
  1. Private Sub CommandButton17_Click()
  2. Set copysheet = ThisWorkbook.Sheets("In out record")
  3. copysheet.Activate
  4. copysheet.Range("A1:O49").Select
  5.     Selection.Copy
  6.     Sheets.Add After:=Sheets(Sheets.Count)
  7.     Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
  8.         SkipBlanks:=False, Transpose:=False
  9.     ActiveSheet.Paste
  10.     ActiveSheet.Name = "In out record 2"
  11. Set copysheet2 = ThisWorkbook.Sheets("In out record 2")

  12. copysheet2.Copy After:=Sheets("In out record 2")
  13. Set ATworksheet = Sheets(Sheets("In out record 2").Index + 1)
  14. ATworksheet.Name = "In out record_AT"

  15. Set wSheetStart = ThisWorkbook.Sheets("AT")
  16. wSheetStart.Activate
  17. wSheetStart.AutoFilterMode = False
  18. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now - 3), Month(Now - 3), Day(Now - 3)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now - 3), Month(Now - 3), Day(Now - 3))
  19. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then

  20. Worksheets("AT").Range("B7").Select
  21.     Worksheets("AT").Range("B7:N7").Select
  22.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  23.     Selection.Copy
  24. ATworksheet.Activate
  25. ATworksheet.Range("B17").PasteSpecial

  26.   ATworksheet.Range("C12").Value = "AT"
  27.    
  28.     Set btn = ActiveSheet.Buttons.Add(477, 177, 40, 40)
  29.     With btn
  30.     .OnAction = "btnS"
  31.     .Caption = "Save As"
  32.     .Name = "Save As"
  33.     Application.ScreenUpdating = True
  34.     End With
  35.    
  36.     ATworksheet.Range("B21").Select
  37.    
  38.     wSheetStart.Activate
  39. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now - 2), Month(Now - 2), Day(Now - 2)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now - 2), Month(Now - 2), Day(Now - 2))
  40. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
  41. Worksheets("AT").Range("B7").Select

  42.     Worksheets("AT").Range("B7:N7").Select

  43.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  44.     Selection.Copy
  45. ATworksheet.Activate
  46. ATworksheet.Range("B17").End(xlUp).Offset(1).PasteSpecial

  47. wSheetStart.Activate
  48. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now - 1), Month(Now - 1), Day(Now - 1)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now - 1), Month(Now - 1), Day(Now - 1))
  49. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
  50. Worksheets("AT").Range("B7").Select

  51.     Worksheets("AT").Range("B7:N7").Select
  52.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  53.     Selection.Copy
  54. ATworksheet.Activate
  55. ATworksheet.Range("B17").End(xlUp).Offset(3).PasteSpecial

  56. wSheetStart.Activate
  57. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now), Month(Now), Day(Now)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now), Month(Now), Day(Now))
  58. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
  59. Worksheets("AT").Range("B7").Select

  60.     Worksheets("AT").Range("B7:N7").Select
  61.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  62.     Selection.Copy
  63. ATworksheet.Activate
  64. ATworksheet.Range("B17").End(xlUp).Offset(5).PasteSpecial

  65. wSheetStart.Activate
  66. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now + 1), Month(Now + 1), Day(Now + 1)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now + 1), Month(Now + 1), Day(Now + 1))
  67. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
  68. Worksheets("AT").Range("B7").Select
  69.     Worksheets("AT").Range("B7:N7").Select
  70.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  71.     Selection.Copy
  72. ATworksheet.Activate
  73. ATworksheet.Range("B17").End(xlUp).Offset(7).PasteSpecial

  74. wSheetStart.Activate
  75. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now + 2), Month(Now + 2), Day(Now + 2)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now + 2), Month(Now + 2), Day(Now + 2))
  76. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
  77. Worksheets("AT").Range("B7").Select
  78.     Worksheets("AT").Range("B7:N7").Select
  79.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  80.     Selection.Copy
  81. ATworksheet.Activate
  82. ATworksheet.Range("B17").End(xlUp).Offset(9).PasteSpecial

  83. wSheetStart.Activate
  84. ActiveSheet.Range("A6:AC6").AutoFilter Field:=6, Criteria1:=">=" & DateSerial(Year(Now + 3), Month(Now + 3), Day(Now + 3)), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now + 3), Month(Now + 3), Day(Now + 3))
  85. If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
  86. Worksheets("AT").Range("B7").Select
  87.     Worksheets("AT").Range("B7:N7").Select
  88.     Worksheets("AT").Range(Selection, Selection.End(xlDown)).Select
  89.     Selection.Copy
  90. ATworksheet.Activate
  91. ATworksheet.Range("B17").End(xlUp).Offset(11).PasteSpecial

  92. End If
  93. End If
  94. End If
  95. End If
  96. End If
  97. End If
  98. End If
  99. End Sub
  100.    
½Æ»s¥N½X

¦³ªþÀÉ·|§ó¦n

TOP

        ÀR«ä¦Û¦b : ­n§åµû§O¤H®É¡A¥ý·Q·Q¦Û¤v¬O§_§¹¬üµL¯Ê¡C
ªð¦^¦Cªí ¤W¤@¥DÃD