求高手修改<em>excel</em>的<em>宏命令</em>

dim i
for i = 0 to 100
range("H1225:AL1226").offset(i,).select
next

请先将 菜单【工具】【宏】【安全性】设置为：低，退出!
在72个文件夹的同级目录下新建一个Excel文件“汇总-资产负债表.xls” 双击，打开这个文件！
Alt+F11，打开VBE编辑器，双击ThisWorkbook，在代码窗口粘贴下面的代码：

Sub ouyangff()
Dim Mypath, Myname As String, sht As Worksheet
Application.Calculation = xlManual '关闭自动重算
i = 1
Mypath = ThisWorkbook.Path & "\" '获取工作表所在的文件夹的路径
Myname = Dir(Mypath, vbDirectory)
Do While Myname <> ""
If Myname <> "." And Myname <> ".." Then
If GetAttr(Mypath & Myname) = vbDirectory Then '是文件夹吗？
Sheet1.Cells(i, 1) = Myname '将文件夹名称留下
i = i + 1
End If
End If
Myname = Dir '读下一e799bee5baa6e997aee7ad94e78988e69d83365个
Loop
For i = 501 To 572 '若有 表501、502……则删除
For Each sht In Sheets
If Val(sht.Name) = i Then
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = True
End If
Next
Next
For i = 1 To [a65536].End(3).Row '添加 sheet 501、502…… 72个表
Set sht = Worksheets.Add(after:=Worksheets(Worksheets.Count), Count:=1)
sht.Name = Right(Sheets(1).Cells(i, 1), 3)
Workbooks.Open Mypath & Sheets(1).Cells(i, 1) & "\" & "资产负债表.xls" '打开资产负债表.xls
Workbooks("资产负债表.xls").Sheets("sheet1").Cells.Copy sht.Cells '拷贝到 501、502……中
Workbooks("资产负债表.xls").Close '关闭文件
Next
Application.Calculation = xlAutomatic '打开自动重算
ActiveWorkbook.PrecisionAsDisplayed = False
Calculate

End Sub

按F5运行程序，按Alt + F11 回到Excel 里去看看结果！
还有问题，请留言，祝你工作顺利！！！

Sub 宏1()
    Dim rng As Range, RngR As Long, RngC As Integer, Rng_Str() As String
    Dim Cou As Long, SelXu As Byte
    Do While rng Is Nothing
        On Error Resume Next
        Set rng = Application.InputBox("请选择需要执行的过程的区域范围e68a84e8a2ade79fa5e98193336", "范围选择", Selection.Address(0, 0), , , , , 8)
        If rng Is Nothing <> 0 Then End
    Loop

    ReDim Rng_Str(1 To rng.Rows.Count, 1 To rng.Columns.Count)
    Application.ScreenUpdating = False
             For RngC = 2 To rng.Columns.Count Step 2
                For RngR = 1 To rng.Rows.Count
                    If Len(rng(RngR, RngC).Value) <> 0 Then
                       Cou = Cou + 1
                       Rng_Str(Cou, RngC - 1) = rng(RngR, RngC - 1)
                       Rng_Str(Cou, RngC) = rng(RngR, RngC)
                    End If
                Next RngR
                Cou = 0
            Next RngC
     With rng(1, 1).Resize(rng.Rows.Count, rng.Columns.Count)
        .ClearContents
        .Interior.ColorIndex = 0
        .Value = Rng_Str
    End With
    Application.ScreenUpdating = True
End Sub
Sub宏2()
Dim rc, rT As Range
With Sheet4
    Set rT = .Range("B14:K28")
    For Each rc In rT
        If Application.WorksheetFunction.CountIf(.Range(Chr(rc.Column + 64) & rT.Row & ":" & Chr(rc.Column + 64) & rc.Row), rc) > 1 Then
            .Range(rc.Address) = ""
        End If
    Next
    For Each rc In rT
        If Application.WorksheetFunction.CountIf(.Range(rT.Address), rc) < 2 Then
            .Range(rc.Address) = ""
        End If
    Next
End With
End Sub

你这来录的代码 起码 能简源化百为原来的 1/3
如果是度你选中的知 单元格 range("F637") 改为道 Selection
range("E637:F656")改为 selection.currentregion