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

[µo°Ý] ¨D°ª¤âÀ°¦£Â²¤Æµ{¦¡½X

[µo°Ý] ¨D°ª¤âÀ°¦£Â²¤Æµ{¦¡½X

µ{¦¡¤º®e¬O±Nsheet1¿z¿ï«áªº¸ê®Æ½Æ»s¨ìsheet2ªº¦X¨ÖÀx¦s®æ
¥Ø«e¿ý»sªº¤èªk¬O½Æ»s¨ìsheet2«á¡A¦A¦X¨ÖÀx¦s®æ
sheet1ªº¸ê®Æ¬OÅܰʪº
sheet2ªº¦X¨ÖÀx¦s®æ¬O¥H5¦C¦X¨Ö¬°·Ç
§Æ±æ¯à¥Î°j°é©Î¨ä¥L¤è¦¡Â²¤Æµ{¦¡½X
  1. Sub ¥¨¶°2()
  2.     Range("E9:G15").Select
  3.     Selection.AutoFilter
  4.     ActiveSheet.Range("$E$9:$G$15").AutoFilter Field:=1, Criteria1:="=¥Øµø", _
  5.         Operator:=xlOr, Criteria2:="=´å¼Ð¥d¤Ø"
  6.     Range("A9").Select
  7.     Selection.Copy
  8.     Sheets("¤u§@ªí3").Select
  9.     Range("A13").Select
  10.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  11.         :=False, Transpose:=False
  12.     Sheets("¤u§@ªí1").Select
  13.     Range("A11").Select
  14.     Application.CutCopyMode = False
  15.     Selection.Copy
  16.     Sheets("¤u§@ªí3").Select
  17.     Range("A18").Select
  18.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  19.         :=False, Transpose:=False
  20.     Sheets("¤u§@ªí1").Select
  21.     Range("A14").Select
  22.     Application.CutCopyMode = False
  23.     Selection.Copy
  24.     Sheets("¤u§@ªí3").Select
  25.     Range("A23").Select
  26.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  27.         :=False, Transpose:=False
  28.     Sheets("¤u§@ªí1").Select
  29.     Range("A15").Select
  30.     Application.CutCopyMode = False
  31.     Selection.Copy
  32.     Sheets("¤u§@ªí3").Select
  33.     Range("A28").Select
  34.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  35.         :=False, Transpose:=False
  36.     Sheets("¤u§@ªí1").Select
  37.     Range("B9:D9").Select
  38.     Application.CutCopyMode = False
  39.     Selection.Copy
  40.     Sheets("¤u§@ªí3").Select
  41.     Range("B13").Select
  42.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  43.         :=False, Transpose:=False
  44.     Sheets("¤u§@ªí1").Select
  45.     Range("B11:D11").Select
  46.     Application.CutCopyMode = False
  47.     Selection.Copy
  48.     Sheets("¤u§@ªí3").Select
  49.     Range("B18").Select
  50.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  51.         :=False, Transpose:=False
  52.     Sheets("¤u§@ªí1").Select
  53.     Range("B14:D14").Select
  54.     Application.CutCopyMode = False
  55.     Selection.Copy
  56.     Sheets("¤u§@ªí3").Select
  57.     Range("B23").Select
  58.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  59.         :=False, Transpose:=False
  60.     Sheets("¤u§@ªí1").Select
  61.     Range("B15:D15").Select
  62.     Application.CutCopyMode = False
  63.     Selection.Copy
  64.     Sheets("¤u§@ªí3").Select
  65.     Range("B28").Select
  66.     ActiveSheet.Paste
  67.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  68.         :=False, Transpose:=False
  69.     Sheets("¤u§@ªí1").Select
  70.     Range("E9:G9").Select
  71.     Application.CutCopyMode = False
  72.     ActiveCell.FormulaR1C1 = "¥Øµø"
  73.     Sheets("¤u§@ªí3").Select
  74.     Range("B13").Select
  75.     ActiveCell.FormulaR1C1 = "SIPCSS002-00¥Øµø"
  76.     Range("B14").Select
  77.     Sheets("¤u§@ªí1").Select
  78.     Range("E11:G11").Select
  79.     ActiveCell.FormulaR1C1 = "´å¼Ð¥d¤Ø"
  80.     Sheets("¤u§@ªí3").Select
  81.     Range("B18").Select
  82.     ActiveCell.FormulaR1C1 = "£p19.93-20.07 ´å¼Ð¥d¤Ø"
  83.     Range("B19").Select
  84.     Sheets("¤u§@ªí1").Select
  85.     Range("E14:G14").Select
  86.     ActiveCell.FormulaR1C1 = "´å¼Ð¥d¤Ø"
  87.     Sheets("¤u§@ªí3").Select
  88.     Range("B23").Select
  89.     ActiveCell.FormulaR1C1 = "14.90-15.10 ´å¼Ð¥d¤Ø"
  90.     Range("B24").Select
  91.     Sheets("¤u§@ªí1").Select
  92.     Range("E15:G15").Select
  93.     ActiveCell.FormulaR1C1 = "¥Øµø"
  94.     Sheets("¤u§@ªí3").Select
  95.     Range("B28").Select
  96.     ActiveCell.FormulaR1C1 = "³U¸Ë ¥Øµø"
  97.     Range("A13:A17").Select
  98.     With Selection
  99.         .HorizontalAlignment = xlCenter
  100.         .VerticalAlignment = xlCenter
  101.         .WrapText = False
  102.         .Orientation = 0
  103.         .AddIndent = False
  104.         .IndentLevel = 0
  105.         .ShrinkToFit = False
  106.         .ReadingOrder = xlContext
  107.         .MergeCells = False
  108.     End With
  109.     Selection.Merge
  110.     Range("B13:B17").Select
  111.     With Selection
  112.         .HorizontalAlignment = xlCenter
  113.         .VerticalAlignment = xlCenter
  114.         .WrapText = False
  115.         .Orientation = 0
  116.         .AddIndent = False
  117.         .IndentLevel = 0
  118.         .ShrinkToFit = False
  119.         .ReadingOrder = xlContext
  120.         .MergeCells = False
  121.     End With
  122.     Selection.Merge
  123.     With Selection
  124.         .HorizontalAlignment = xlCenter
  125.         .VerticalAlignment = xlCenter
  126.         .WrapText = True
  127.         .Orientation = 0
  128.         .AddIndent = False
  129.         .IndentLevel = 0
  130.         .ShrinkToFit = False
  131.         .ReadingOrder = xlContext
  132.         .MergeCells = True
  133.     End With
  134.     ActiveCell.FormulaR1C1 = "SIPCSS002-00     ¥Øµø"
  135.     Range("B13:B17").Select
  136.     ActiveCell.FormulaR1C1 = "SIPCSS002-00           ¥Øµø"
  137.     Range("A18:A22").Select
  138.     With Selection
  139.         .HorizontalAlignment = xlCenter
  140.         .VerticalAlignment = xlCenter
  141.         .WrapText = False
  142.         .Orientation = 0
  143.         .AddIndent = False
  144.         .IndentLevel = 0
  145.         .ShrinkToFit = False
  146.         .ReadingOrder = xlContext
  147.         .MergeCells = False
  148.     End With
  149.     Selection.Merge
  150.     Range("B18:B22").Select
  151.     With Selection
  152.         .HorizontalAlignment = xlCenter
  153.         .VerticalAlignment = xlCenter
  154.         .WrapText = False
  155.         .Orientation = 0
  156.         .AddIndent = False
  157.         .IndentLevel = 0
  158.         .ShrinkToFit = False
  159.         .ReadingOrder = xlContext
  160.         .MergeCells = False
  161.     End With
  162.     Selection.Merge
  163.     With Selection
  164.         .HorizontalAlignment = xlCenter
  165.         .VerticalAlignment = xlCenter
  166.         .WrapText = True
  167.         .Orientation = 0
  168.         .AddIndent = False
  169.         .IndentLevel = 0
  170.         .ShrinkToFit = False
  171.         .ReadingOrder = xlContext
  172.         .MergeCells = True
  173.     End With
  174.     Range("B18:B22").Select
  175.     ActiveCell.FormulaR1C1 = "£p19.93-20.07          ´å¼Ð¥d¤Ø"
  176.     Range("A23:A27").Select
  177.     With Selection
  178.         .HorizontalAlignment = xlCenter
  179.         .VerticalAlignment = xlCenter
  180.         .WrapText = False
  181.         .Orientation = 0
  182.         .AddIndent = False
  183.         .IndentLevel = 0
  184.         .ShrinkToFit = False
  185.         .ReadingOrder = xlContext
  186.         .MergeCells = False
  187.     End With
  188.     Selection.Merge
  189.     Range("B23:B27").Select
  190.     With Selection
  191.         .HorizontalAlignment = xlCenter
  192.         .VerticalAlignment = xlCenter
  193.         .WrapText = False
  194.         .Orientation = 0
  195.         .AddIndent = False
  196.         .IndentLevel = 0
  197.         .ShrinkToFit = False
  198.         .ReadingOrder = xlContext
  199.         .MergeCells = False
  200.     End With
  201.     Selection.Merge
  202.     With Selection
  203.         .HorizontalAlignment = xlCenter
  204.         .VerticalAlignment = xlCenter
  205.         .WrapText = True
  206.         .Orientation = 0
  207.         .AddIndent = False
  208.         .IndentLevel = 0
  209.         .ShrinkToFit = False
  210.         .ReadingOrder = xlContext
  211.         .MergeCells = True
  212.     End With
  213.     ActiveCell.FormulaR1C1 = "14.90-15.10          ´å¼Ð¥d¤Ø"
  214.     Range("A28:A32").Select
  215.     With Selection
  216.         .HorizontalAlignment = xlCenter
  217.         .VerticalAlignment = xlCenter
  218.         .Orientation = 0
  219.         .AddIndent = False
  220.         .IndentLevel = 0
  221.         .ShrinkToFit = False
  222.         .ReadingOrder = xlContext
  223.         .MergeCells = False
  224.     End With
  225.     Selection.Merge
  226.     Range("B28:B32").Select
  227.     With Selection
  228.         .HorizontalAlignment = xlCenter
  229.         .VerticalAlignment = xlCenter
  230.         .Orientation = 0
  231.         .AddIndent = False
  232.         .IndentLevel = 0
  233.         .ShrinkToFit = False
  234.         .ReadingOrder = xlContext
  235.         .MergeCells = False
  236.     End With
  237.     Selection.Merge
  238.     With Selection
  239.         .HorizontalAlignment = xlCenter
  240.         .VerticalAlignment = xlCenter
  241.         .WrapText = True
  242.         .Orientation = 0
  243.         .AddIndent = False
  244.         .IndentLevel = 0
  245.         .ShrinkToFit = False
  246.         .ReadingOrder = xlContext
  247.         .MergeCells = True
  248.     End With
  249.     ActiveCell.FormulaR1C1 = "³U¸Ë         ¥Øµø"
  250.     Range("B33").Select
  251.     Sheets("¤u§@ªí1").Select
  252.     Selection.AutoFilter
  253. End Sub
½Æ»s¥N½X
test¿z¿ï½Æ»s.rar (26.52 KB)

¦^´_ 1# s13030029

Sub test_20190530()
    ROW1 = Cells(Rows.Count, "E").End(3).Row
    Range("E9:G" & ROW1).Select
    Selection.AutoFilter
    ActiveSheet.Range("$E$9:$G$" & ROW1).AutoFilter Field:=1, Criteria1:="=¥Øµø", _
        Operator:=xlOr, Criteria2:="=´å¼Ð¥d¤Ø"
    Sheets("¤u¡±@ªí3").Cells.Clear
    Range("A9:G" & ROW1).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("¤u¡±@ªí3").Select
    Range("A1").Select
    ActiveSheet.Paste
    ROW2 = Cells(Rows.Count, "A").End(3).Row
    Range("H1:H" & ROW2) = "=B1 & "" "" & E1"
    Range("H1:H" & ROW2).Value = Range("H1:H" & ROW2).Value
    Columns("B:G").Delete Shift:=xlToLeft
    For i = ROW2 To 1 Step -1
        Range("A" & i & ":A" & i + 4).Merge
        Range("B" & i & ":B" & i + 4).Merge
        Range("B" & i & ":B" & i + 4).WrapText = True
        Range("B" & i & ":B" & i + 4).HorizontalAlignment = xlCenter
        Rows(i & ":" & i + 3).Insert Shift:=xlDown
    Next
    ROW2 = Cells(Rows.Count, "A").End(3).Row
    Range("A5:B" & ROW2).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A5").Select
    Columns("B:B").ColumnWidth = 12
    Sheets(1).Select
    Selection.AutoFilter
    Range("A9").Select
End Sub

    test¿z¿ï½Æ»s.zip (27.27 KB)

TOP

¦^´_ 1# s13030029
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng(1 To 2) As Range, xRow As Integer, AR, i As Integer, xI As Integer
  4.     With Sheets("¤u§@ªí1")
  5.         xRow = .[A9].End(xlDown).Row
  6.         With .Range("$E$9:$G" & xRow)
  7.             .AutoFilter
  8.             .AutoFilter Field:=1, Criteria1:="=¥Øµø", Operator:=xlOr, Criteria2:="=´å¼Ð¥d¤Ø"
  9.             '***¿z¿ï«áAÄæ¨ìGÄ檺¸ê®Æ°Ï°ì******
  10.             Set Rng(1) = .Parent.Range("A10:G" & xRow).SpecialCells(xlCellTypeVisible)
  11.             '*********************************
  12.             Set Rng(2) = Sheets("¤u§@ªí3").[A13]
  13.             For i = 1 To Rng(1).Areas.Count                 '**¿z¿ï«á¸ê®Æ ¤£¤@©w¬O³sÄòªº
  14.                 For xI = 1 To Rng(1).Areas(i).Rows.Count    ''**¿z¿ï«á¸ê®Æªº Areas ¶°¦X¡A¦¹¶°¦X¥Nªí¦h°Ï°ì¿ï¨ú½d³ò¤¤ªº©Ò¦³½d³ò¡C
  15.                     AR = Application.Transpose(Application.Transpose(Rng(1).Areas(i).Rows(xI)))
  16.                     'Rng(1).Areas(i).Rows(xI) Âà´«¦¨¤@ºû°}¦C
  17.                     
  18.                     '***³B²z ¿z¿ï«áAÄæ¨ìGÄ檺¸ê®Æ°Ï°ì  ¤¤¦³¨S¦³¸ê®ÆªºÄæ¦ì******
  19.                     AR = Join(AR, ",")  '°}¦C¥H","³sµ²Âର¤å¦r
  20.                     Do While InStr(AR, ",,")
  21.                         AR = Replace(AR, ",,", ",")  ' ** ®ø°£¦h¾lªº","  '
  22.                     Loop
  23.                     AR = Split(Mid(AR, 1, Len(AR) - 1), ",")  '¤å¦r¥H","Âର°}¦C
  24.                     With Rng(2)
  25.                         .Cells(1) = AR(0)
  26.                         .Cells(1, 2) = AR(1) & vbLf & AR(2)
  27.                         EX_®æ¦¡ .Cells(1).Resize(5)
  28.                         EX_®æ¦¡ .Cells(1, 2).Resize(5)
  29.                     End With
  30.                     Set Rng(2) = Rng(2).Offset(1)
  31.                 Next
  32.            Next
  33.         End With
  34.     End With
  35. End Sub
  36. Sub EX_®æ¦¡(ByVal Target As Range)
  37.     With Target
  38.         .HorizontalAlignment = xlCenter
  39.         .VerticalAlignment = xlCenter
  40.         .WrapText = False
  41.         .Orientation = 0
  42.         .AddIndent = False
  43.         .IndentLevel = 0
  44.         .ShrinkToFit = False
  45.         .ReadingOrder = xlContext
  46.         '.MergeCells = True
  47.          .Merge
  48.     End With
  49. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : §Ñ¥\¤£§Ñ¹L¡A§Ñ«è¤£§Ñ®¦¡C
ªð¦^¦Cªí ¤W¤@¥DÃD