1. Sub 锁定视图()
    2. '
    3. ' Macro1 Macro
    4. ' 宏由 liujian 录制，时间: 2020/11/12
    5. '
    7. '
    9.     Range("B2").Select
    10.     ActiveWindow.FreezePanes = True
    11.     Range("B1").Select
    12.     Selection.AutoFilter
    13.    ' ActiveWorkbook.Names.Add Name:="'3131'!_FilterDatabase", RefersTo:="='3131'!$A$1:$M$40502", Visible:=False
    14.     Range("A1:M40502").AutoFilter Field:=2, Criteria1:=">=104", Operator:=xlAnd, Criteria2:="<=500"
    15.    ' ActiveWorkbook.Names.Add Name:="'3131'!_FilterDatabase", RefersTo:="='3131'!$A$1:$M$40502", Visible:=False
    16. End Sub
    17. Sub 复制区域()
    18. '
    19. ' 复制区域 Macro
    20. ' 宏由 liujian 录制，时间: 2020/11/12
    21. '
    23. '
    26. Sheets("data").Activate
    27. Range("A722118:M761718").Select
    28. Selection.Copy
    29. Sheets("3142").Activate
    30. Range("A2").Select
    31. ActiveSheet.Paste
    33. Sheets("data").Activate
    34. Range("A761718:M804018").Select
    35. Selection.Copy
    36. Sheets("3143").Activate
    37. Range("A2").Select
    38. ActiveSheet.Paste
    40. Sheets("data").Activate
    41. Range("A804918:M811622").Select
    42. Selection.Copy
    43. Sheets("3144").Activate
    44. Range("A2").Select
    45. ActiveSheet.Paste
    47. End Sub
    49. Sub 混合排序()
    50. '
    51. ' 混合排序 Macro
    52. ' 宏由 liujian 录制，时间: 2020/10/19
    53. '
    55. '
    56.     Columns("F:F").Select
    57.     Selection.Copy
    58.     Range("C1").Select
    59.     ActiveSheet.Paste
    60.     Columns("H:H").Select
    61.     Selection.Copy
    62.     Range("D1").Select
    63.     ActiveSheet.Paste
    64.     Columns("K:K").Select
    65.     Selection.Copy
    66.     Range("E1").Select
    67.     ActiveSheet.Paste
    68.     Columns("C:C").Select
    69.     Application.CutCopyMode = False
    70.     Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, TextQualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="混", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
    71. End Sub
    72. Sub 新建N个工作表()
    75. ' 批量新建多个sheet表，新建一个cresheet的宏
    76. Dim a As Integer               '定义a变量
    77. a = 2                                '初始值，从第二行开始，可以更改
    78. Set st = Worksheets("分析")       ' 表初始值，定位源数据表，可以更改
    79. Do While st.Cells(a, "A") <> ""   ' 设定循环条件，从神山表中的A2开始，如果数据不为空，执行该循环
    80. On Error Resume Next            ' 若表名不存在，忽略代码引起的运行错误
    81. If Worksheets(st.Cells(a, "A").Value) Is Nothing Then '判断是否存在对应的工作表
    82. Worksheets("666").Copy After:=Worksheets(Worksheets.Count)
    83. 'Worksheets.Add After:=Worksheets(Worksheets.Count)
    84. '永远将新表加入到最后一个工作表之后
    86. ActiveSheet.Name = st.Cells(a, "A").Value             '新的工作表为当前活动的工作，将工作表的名称更改为神山表中对应单元格的名字。
    87. End If
    88. a = a + 1   '行号加1，继续新增下一个
    89. Loop
    90. End Sub
    91. '结束宏
    92. Sub 替换a00()
    93. '
    94. ' 替换a00 Macro
    95. ' 宏由 liujian 录制，时间: 2020/08/10
    96. '
    98. '
    99.     Selection.Replace What:="a00", Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, MatchByte:=False, SearchFormat:=True, ReplaceFormat:=True
    100.     Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, MatchByte:=False, SearchFormat:=True, ReplaceFormat:=True
    101.     Selection.Replace What:="#DIV/0!", Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, MatchByte:=False, SearchFormat:=True, ReplaceFormat:=True
    102. End Sub
    104. Sub 清空汇总性能()
    105. '
    106. ' 清空汇总性能 Macro
    107. ' 宏由 liujian 录制，时间: 2020/08/09
    108. '
    110. '
    111.     Rows("4:200").Select
    112.     Selection.Delete Shift:=xlShiftUp
    113.    ActiveWindow.ScrollRow = 3
    115. End Sub
    116. Sub 删除位置列()
    117. '
    118. ' 删除位置列 Macro
    119. ' 宏由 liujian 录制，时间: 2020/08/09
    120. '
    122. '
    123.     Range("I4:I300").Select
    124.     Selection.Delete Shift:=xlShiftToLeft
    125.     ActiveWindow.ScrollRow = 3
    126. End Sub
    127. Sub 删除标题行()
    128. '
    129. ' 删除标题行 Macro
    130. ' 宏由 liujian 录制，时间: 2020/09/01
    131. '
    133. '
    135.     Range("A1").Select
    136.     Selection.AutoFilter
    137.     ActiveWorkbook.Names.Add Name:="'2007'!_FilterDatabase", RefersTo:="='2007'!$A$1:$S$267903", Visible:=False
    138.     Range("A1:S267903").AutoFilter Field:=1, Criteria1:=Array("", "Date"), Operator:=xlFilterValues
    139.     ActiveWorkbook.Names.Add Name:="'2007'!_FilterDatabase", RefersTo:="='2007'!$A$1:$S$267903", Visible:=False
    140.     Range("A4322:A267903").Select
    141.     ActiveWindow.ScrollRow = 86421
    142.     Rows("4322:267903").Delete Shift:=xlShiftUp
    143.     ActiveWindow.ScrollRow = 1
    144.     Range("A1:S267841").AutoFilter Field:=1
    145.     ActiveWorkbook.Names.Add Name:="'2007'!_FilterDatabase", RefersTo:="='2007'!$A$1:$S$267841", Visible:=False
    146. End Sub

    都是些奇技淫巧，不按正规思路来的东西

    80万行数据就这么来处理
    6G的内存经常不够用