| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 566 人关注过本帖
标题:VB实现表格自动另存
只看楼主 加入收藏
hahazeng
Rank: 1
等 级:新手上路
帖 子:16
专家分:0
注 册:2009-8-19
结帖率:25%
收藏
已结贴  问题点数:10 回复次数:8 
VB实现表格自动另存
那个高手能帮帮忙,用VB有条件实现表格自动另存,且贴值,删除多余的表格。
附件.zip (122.87 KB)
2014-02-18 16:11
hahazeng
Rank: 1
等 级:新手上路
帖 子:16
专家分:0
注 册:2009-8-19
收藏
得分:0 
自己弄了一个,但只能实现部分功能,那位老师指点一下?
附件.zip (133.82 KB)
2014-02-19 16:31
hahazeng
Rank: 1
等 级:新手上路
帖 子:16
专家分:0
注 册:2009-8-19
收藏
得分:0 
那个老师帮忙看看啦
2014-02-20 09:13
alike123
Rank: 6Rank: 6
等 级:侠之大者
威 望:8
帖 子:107
专家分:428
注 册:2014-2-10
收藏
得分:4 
这看也看个半死不活了,问题可不可以再简略概括一下,把大问题拆分一下
不然别人先要看懂你意思,然后看懂你表格,再想办法解决,我觉得一般人都不会做下去
你只能等有限的几个版主帮你了
2014-02-21 10:48
w360989426
Rank: 5Rank: 5
等 级:职业侠客
威 望:4
帖 子:228
专家分:301
注 册:2013-11-12
收藏
得分:4 
建议你使用数据库。。。。excel不适合储存数据
2014-02-22 13:55
owenlu1981
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:13
帖 子:211
专家分:1130
注 册:2013-5-17
收藏
得分:4 
数据模板.zip (132.42 KB)

看看是否OK
2014-02-24 14:58
hahazeng
Rank: 1
等 级:新手上路
帖 子:16
专家分:0
注 册:2009-8-19
收藏
得分:0 
回复 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工作表的功能。
2014-02-25 21:51
hahazeng
Rank: 1
等 级:新手上路
帖 子:16
专家分:0
注 册:2009-8-19
收藏
得分:0 
老师呢,都这么忙吗?
2014-02-26 23:18
owenlu1981
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:13
帖 子:211
专家分:1130
注 册:2013-5-17
收藏
得分:0 
提供下初始文档和需要的结果示例吧,你给的Request不是很明白。
2014-02-27 16:28
快速回复:VB实现表格自动另存
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.047193 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved