很卡，请高手帮忙简化代码

yysfcq

Sub 入库导入总档()
'
' 入库导入总档 宏
'

'

Range("A1").Select
    Sheets("总档").Select
    Range("A2:M2").Select
    Selection.AutoFilter
    Selection.AutoFilter
    Selection.AutoFilter
    Selection.AutoFilter
    Range("A1").Select
    Sheets("入库").Select
    Range("A1").Select
    ActiveSheet.Range("$A$2:$I$10069").AutoFilter Field:=7, Criteria1:="="


    ActiveWindow.SmallScroll Down:=-6
    Range("C2").Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("总档").Select
    Range("B1045936").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入库").Select
    ActiveCell.Offset(-2, 0).Range("A1").Select
   Range("E2").Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("总档").Select
    Range("J1045936").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入库").Select
    ActiveCell.Offset(-2, -3).Range("A1").Select
    Range("A2:I2").Select
    Selection.AutoFilter
    Selection.AutoFilter
    Selection.AutoFilter
    Selection.AutoFilter
    Range("A1").Select


    Range("D1").Select
    Sheets("总档").Select
    Range("I1").Select
    Application.ScreenUpdating = False
mrow = Sheets("总档").Cells(Rows.Count, "B").End(3).Row
Range([C2510], Cells(mrow, "I")).FillDown
Application.ScreenUpdating = True
    Sheets("入库").Select
    Range("D1").Select
        Calculate
    Calculate
    ActiveWorkbook.Save
    MsgBox "做账成功！"

End Sub




Sub 出库()
'
' 出库 宏
'

'
Range("C2").Select
    Sheets("出库").Select
    Range("A2:I2").Select
    Selection.AutoFilter
    Selection.AutoFilter
    Selection.AutoFilter
    Selection.AutoFilter
    Sheets("领料").Select
    Range("C2").Select

        Range("H4:H300").Select
    Selection.Copy
    Sheets("出库").Select
    Range("E1048576").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 3).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("领料").Select

    ActiveWindow.ScrollRow = 1
    ActiveCell.Offset(-2, -5).Range("A1").Select
    Range("B4:E300").Select
    Selection.Copy
    Sheets("出库").Select
    Range("C1048576").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, -1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("领料").Select
    ActiveWindow.ScrollRow = 1
    ActiveCell.Offset(-2, 1).Range("A1").Select
            Range("A4:H4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("C2").Select

                Range("D1").Select
    Sheets("出库").Select
    Range("I1").Select
    Application.ScreenUpdating = False
mrow = Sheets("出库").Cells(Rows.Count, "E").End(3).Row
Range([F4], Cells(mrow, "G")).FillDown
Application.ScreenUpdating = True
    Sheets("领料").Select
    Range("D1").Select

        Range("C2").Select
    Sheets("出库").Select
    Range("C1048576").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, -2).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Sheets("领料").Select
    ActiveCell.Select


    Calculate
    Calculate

    ActiveWorkbook.Save
    MsgBox "做账成功！"
End Sub

大灰狼1976

很复杂，还是发个示例说明一下想要什么结果比较好，改代码太麻烦，不如重写

林木水

应该是录制了一个宏吧，这么复杂，看都不想看

yysfcq

yysfcq

sam-wang

yysfcq 发表于 2021-12-28 09:42

請問方便提ˊ供附檔嗎? 且有需求結果說明，感謝

zhanglei1371

一看就是直接录制的宏代码，速度肯定慢了。要想快，需要会VBA，将所有操作在数组里完成，再写回去

山海风云轩

直接发模板出来，写明要求，编辑代码
你这个录制的太复杂了