对1.5万行数据透视表的处理＝＝＝＝VBA填充代码（快捷键代码+ＯＦＦＳＥＴ函数代码）

引子玄

Sub 分步填充前激活范围()
    Application.Goto Reference:="R15000C1"
    ActiveCell.FormulaR1C1 = "0"
    Range("A15000").Select
    Selection.ClearContents
    Range("A1").Select
End Sub
Sub 分步填充1()
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Offset(9999, 0).Select
    Selection.Resize(Selection.Rows.Count + 4999, Selection.Columns.Count).Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[3]C"
End Sub
Sub 分步填充2()
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Offset(4999, 0).Select
    Selection.Resize(Selection.Rows.Count + 4999, Selection.Columns.Count).Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[3]C"
End Sub
Sub 分步填充3()
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Offset(1, 0).Select
    Selection.Resize(Selection.Rows.Count + 4997, Selection.Columns.Count).Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[3]C"
End Sub

引子玄

欢迎多提宝贵修改意见
（注：蓝色部分代码为ＯＦＦＳＥＴ函数代码，黑色部分代码为快捷键操作代码，Ｅ表第２行为＂字段行＂）

引子玄

5000列一次,重复三次填充完成,彻底解决了卡机的难题.(不用15000行在一个表内填充的做法.如果2万行,就重复4次,依此类推重复下去,反正是VBA自动化,次数多下完成总比卡机强!){:soso_e203:}{:soso_e203:}{:soso_e203:}

Sub 分步1()
    Application.Run "透视.xls!ThisWorkbook.表格下方区域文本定位"
    Range("A4").Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Offset(9994, 0).Select
    Selection.Resize(Selection.Rows.Count + 4997, Selection.Columns.Count).Select
End Sub
Sub 分步2()
    Range("A4").Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Offset(4999, 0).Select
    Selection.Resize(Selection.Rows.Count + 4994, Selection.Columns.Count).Select
End Sub
Sub 分步3()
    Range("A4").Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Offset(4, 0).Select
    Selection.Resize(Selection.Rows.Count + 4994, Selection.Columns.Count).Select
End Sub

Sub 填充分步123()
    Selection.Copy
    Sheets("Sheet4").Select
    Range("A6").Select
    ActiveSheet.Paste
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Application.CutCopyMode = False
    Selection.FormulaR1C1 = "=R[3]C"
End Sub

Sub 分步23前清理()
    Rows("6:8").Select
    Selection.Copy
    Rows("5001:5003").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("6:5000").Select
    Range("A6").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

==========>>>后记：解决答案在巧用Set wb = Nothing 优化动作进程（省略步骤）