VB实现表格自动另存 - 编程论坛

#2

hahazeng2014-02-19 16:31

自己弄了一个，但只能实现部分功能，那位老师指点一下？

只有本站会员才能查看附件，请登录

#3

hahazeng2014-02-20 09:13

那个老师帮忙看看啦

#4

alike1232014-02-21 10:48

这看也看个半死不活了，问题可不可以再简略概括一下，把大问题拆分一下
不然别人先要看懂你意思，然后看懂你表格，再想办法解决，我觉得一般人都不会做下去
你只能等有限的几个版主帮你了

#5

w3609894262014-02-22 13:55

建议你使用数据库。。。。excel不适合储存数据

#6

owenlu19812014-02-24 14:58

只有本站会员才能查看附件，请登录

看看是否OK

#7

hahazeng2014-02-25 21:51

回复 6楼 owenlu1981

看了一下您的，离我的要求还有一定的问题：
自己重新弄了一下：
Sub Run()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Mc As String, n%, My As String, m%
With ThisWorkbook
For n = 24 To .Sheets("输入表").[J65536].End(xlUp).Row
Mc = .Sheets("输入表").Cells(n, 10).Value
.Sheets("输入表").[K14] = Mc
.Sheets("信息").[D11] = Mc
For m = 1 To .Sheets("sheet1").[A65536].End(xlUp).Row
My = .Sheets("sheet1").Cells(m, 1).Value
.Sheets("输入表").[L19] = My
.Sheets(Array("表一", "表三甲合", "表三丙", "表四甲1", "表四甲2", "表四甲4")).Copy
ActiveWorkbook.SaveAs Filename:=.Path & "\" & ThisWorkbook.Sheets("信息").Cells(5, 4) & "(" & My & ")预算.xls", FileFormat:=xlNormal
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
ActiveSheet.DrawingObjects.Delete

  For Each Sh In ActiveWorkbook.Sheets
         Sh.Select
         Sh.Cells.Select
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
         Sh.Cells(1, 1).Select
      Next

     '各表删除空行

     With ActiveSheet
        Select Case ShName
        Case "表三丙"
            .Rows.Hidden = False
            iRow = 8
            i = 1
            Do While .Cells(iRow, 2) <> "I"
                If (.Cells(iRow, 6) = "") Or (.Cells(iRow, 6) = 0) Then
                   .Rows(iRow).Delete
                Else
                    .Cells(iRow, 2) = i
                    i = i + 1
                End If
                iRow = iRow + 1
            Loop
        Case Else
        End Select
        .Cells(1, 1).Select
     End With

    ActiveWorkbook.Close (True)

    Next
Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

现有3个问题请教：
1.    “For m = 1 To .Sheets("sheet1").[A65536].End(xlUp).Row”这个循环语句改为定值循环，因为这里只有4个定值：“全套”、“无线”、“电源”、“配套”，怎么改啊？

2.为什么删除空行的宏不行

3.同时还想增加删除生成的工作薄的合计为0工作表的功能。

#8

hahazeng2014-02-26 23:18

老师呢，都这么忙吗？

#9

owenlu19812014-02-27 16:28

提供下初始文档和需要的结果示例吧，你给的Request不是很明白。