返回列表 上一主題 發帖

[發問] 求高手幫忙簡化程式碼

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2019-5-27 09:45 | 顯示全部帖子

[發問] 求高手幫忙簡化程式碼

excel, VBA
程式內容是將sheet1篩選後的資料複製到sheet2的合併儲存格
目前錄製的方法是複製到sheet2後，再合併儲存格
sheet1的資料是變動的
sheet2的合併儲存格是以5列合併為準
希望能用迴圈或其他方式簡化程式碼
  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:="=游標卡尺"
  6.     Range("A9").Select
  7.     Selection.Copy
  8.     Sheets("工作表3").Select
  9.     Range("A13").Select
  10.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  11.         :=False, Transpose:=False
  12.     Sheets("工作表1").Select
  13.     Range("A11").Select
  14.     Application.CutCopyMode = False
  15.     Selection.Copy
  16.     Sheets("工作表3").Select
  17.     Range("A18").Select
  18.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  19.         :=False, Transpose:=False
  20.     Sheets("工作表1").Select
  21.     Range("A14").Select
  22.     Application.CutCopyMode = False
  23.     Selection.Copy
  24.     Sheets("工作表3").Select
  25.     Range("A23").Select
  26.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  27.         :=False, Transpose:=False
  28.     Sheets("工作表1").Select
  29.     Range("A15").Select
  30.     Application.CutCopyMode = False
  31.     Selection.Copy
  32.     Sheets("工作表3").Select
  33.     Range("A28").Select
  34.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  35.         :=False, Transpose:=False
  36.     Sheets("工作表1").Select
  37.     Range("B9:D9").Select
  38.     Application.CutCopyMode = False
  39.     Selection.Copy
  40.     Sheets("工作表3").Select
  41.     Range("B13").Select
  42.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  43.         :=False, Transpose:=False
  44.     Sheets("工作表1").Select
  45.     Range("B11:D11").Select
  46.     Application.CutCopyMode = False
  47.     Selection.Copy
  48.     Sheets("工作表3").Select
  49.     Range("B18").Select
  50.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  51.         :=False, Transpose:=False
  52.     Sheets("工作表1").Select
  53.     Range("B14:D14").Select
  54.     Application.CutCopyMode = False
  55.     Selection.Copy
  56.     Sheets("工作表3").Select
  57.     Range("B23").Select
  58.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  59.         :=False, Transpose:=False
  60.     Sheets("工作表1").Select
  61.     Range("B15:D15").Select
  62.     Application.CutCopyMode = False
  63.     Selection.Copy
  64.     Sheets("工作表3").Select
  65.     Range("B28").Select
  66.     ActiveSheet.Paste
  67.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  68.         :=False, Transpose:=False
  69.     Sheets("工作表1").Select
  70.     Range("E9:G9").Select
  71.     Application.CutCopyMode = False
  72.     ActiveCell.FormulaR1C1 = "目視"
  73.     Sheets("工作表3").Select
  74.     Range("B13").Select
  75.     ActiveCell.FormulaR1C1 = "SIPCSS002-00目視"
  76.     Range("B14").Select
  77.     Sheets("工作表1").Select
  78.     Range("E11:G11").Select
  79.     ActiveCell.FormulaR1C1 = "游標卡尺"
  80.     Sheets("工作表3").Select
  81.     Range("B18").Select
  82.     ActiveCell.FormulaR1C1 = "φ19.93-20.07 游標卡尺"
  83.     Range("B19").Select
  84.     Sheets("工作表1").Select
  85.     Range("E14:G14").Select
  86.     ActiveCell.FormulaR1C1 = "游標卡尺"
  87.     Sheets("工作表3").Select
  88.     Range("B23").Select
  89.     ActiveCell.FormulaR1C1 = "14.90-15.10 游標卡尺"
  90.     Range("B24").Select
  91.     Sheets("工作表1").Select
  92.     Range("E15:G15").Select
  93.     ActiveCell.FormulaR1C1 = "目視"
  94.     Sheets("工作表3").Select
  95.     Range("B28").Select
  96.     ActiveCell.FormulaR1C1 = "袋裝 目視"
  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 = "φ19.93-20.07          游標卡尺"
  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          游標卡尺"
  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 = "袋裝         目視"
  250.     Range("B33").Select
  251.     Sheets("工作表1").Select
  252.     Selection.AutoFilter
  253. End Sub
複製代碼
test篩選複製.rar (26.52 KB)
收藏 分享

        靜思自在 : 【蒙蔽的自由】人常在什麼都可以自由自在的時候，卻被這種隨心所欲的自由蒙蔽，虛擲時光而毫無覺知。
返回列表 上一主題