VB编程excel出问题，高手帮忙解答下，谢谢！

王佰亮 2019-03-15 04:28:29
先说明下：原表格是分上下两块，原表格上部分中标题栏占8行，填写部分15行，中间空一行，下部分表头占3行，填写部分占15行，现想只保留上半部分，不要下半部分，但生成后第一页生成正常，结果第二页生成表格时有断的。麻烦高手如何能生成连续的数据？程序中的程序有的可能是没有用，不专业，麻烦高手解决下，我是菜鸟，告诉我下怎么修改，详细些，万分感激！

Sub 统计材料()

Dim k As Integer
k = Sheets("操作表格").Range("c1").Value

Sheets("上").Select
Range(Cells(7, 2), Cells(7, 60)).Select
Selection.Copy
Range(Cells(8, 2), Cells(k + 7, 60)).Select
ActiveSheet.Paste
'清除剪贴板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False
'转换为文字
Range(Cells(8, 2), Cells(k + 7, 60)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("下").Select
Range(Cells(7, 2), Cells(7, 60)).Select
Selection.Copy
Range(Cells(8, 2), Cells(k + 7, 60)).Select
ActiveSheet.Paste
'清除剪贴板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False
'转换为文字
Range(Cells(8, 2), Cells(k + 7, 60)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("操作表格").Select
End Sub
Sub 恢复初始()

'上下表格恢复初始

Dim k As Integer
k = Sheets("操作表格").Range("c1").Value

Sheets("上").Select
Range(Cells(8, 2), Cells(k + 7, 60)).Select
Selection.ClearContents
Sheets("下").Select
Range(Cells(8, 2), Cells(k + 7, 60)).Select
Selection.ClearContents
Sheets("操作表格").Select

Dim i As Integer
i = Sheets("操作表格").Range("c2").Value
Sheets("管段材料表").Select
Range(Rows(42), Rows(i)).Select
' Selection.Delete Shift:=xlUp
Selection.ClearContents
ActiveSheet.DrawingObjects.Delete
ActiveSheet.PageSetup.PrintArea = "$B$1:$BD$41"
Sheets("操作表格").Select



End Sub
Sub 上下恢复初始()

'上下表格恢复初始

Dim k As Integer
k = Sheets("操作表格").Range("c1").Value

Sheets("上").Select
Range(Cells(8, 2), Cells(k + 7, 60)).Select
Selection.ClearContents
Sheets("下").Select
Range(Cells(8, 2), Cells(k + 7, 60)).Select
Selection.ClearContents
Sheets("操作表格").Select

Sheets("操作表格").Select
End Sub



Sub 复制管段材料表模板()
Dim i As Integer
Dim k As Integer

k = Sheets("操作表格").Range("c2").Value

For i = 1 To k Step 41

Sheets("模板").Select
Rows("1:41").Select
Selection.Copy
Sheets("管段材料表").Select
Range(Cells(i, 1), Cells(i + 40, 60)).Select
ActiveSheet.Paste
'清除剪贴板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False

Next
Sheets("操作表格").Select
End Sub

Sub 生成管段材料表()



'第1页
Sheets("上").Select
Rows("8:22").Select
Selection.Copy
Sheets("管段材料表").Select
Rows("8:22").Select
ActiveSheet.Paste
'清除剪贴板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False

Sheets("下").Select
Rows("8:22").Select
Selection.Copy
Sheets("管段材料表").Select
Rows("26:40").Select
ActiveSheet.Paste

'清除剪贴板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False

'第2页
Dim i As Integer
Dim j As Integer
Dim k As Integer
j = 1
k = Sheets("操作表格").Range("c4").Value
For i = 23 To k Step 15
Sheets("上").Select
Range(Cells(i, 1), Cells(i + 14, 60)).Select
Selection.Copy
Sheets("管段材料表").Select
Range(Cells(i + 26 * j, 1), Cells(i + 26 * j + 14, 60)).Select
ActiveSheet.Paste
'清除剪贴板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False

Sheets("下").Select
Range(Cells(i, 1), Cells(i + 14, 60)).Select
Selection.Copy
Sheets("管段材料表").Select
Range(Cells(i + 18 + 26 * j, 1), Cells(i + 32 + 26 * j, 60)).Select
ActiveSheet.Paste
'清除剪贴板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False
j = j + 1

Next
Sheets("管段材料表").Select
ActiveSheet.PageSetup.PrintArea = "$B:$BD"
Sheets("操作表格").Select

End Sub

...全文
172 10 打赏 收藏 转发到动态 举报
写回复
用AI写文章
10 条回复
切换为时间正序
请发表友善的回复…
发表回复
milaoshu1020 2019-03-17
  • 打赏
  • 举报
 回复
这样:
Sub 复制管段材料表模板()

    Dim i As Integer

    Dim k As Integer

    

    Sheets("管道特性表").Rows.Clear

    k = Sheets("操作表格").Range("c2").Value



    For i = 1 To k Step 41

        Sheets("模板").Select

        Rows("1:41").Select

        Selection.Copy

        Sheets("管道特性表").Select

        Range(Cells(i, 1), Cells(i + 40, 60)).Select

        ActiveSheet.Paste

        '清除剪贴板

        Application.CutCopyMode = False

        Application.CommandBars("Task Pane").Visible = False

    Next

    Sheets("操作表格").Select

 End Sub
王佰亮 2019-03-17
  • 打赏
  • 举报
 回复
第一个问题已解决了，麻烦第二个问题求答案，谢谢！
王佰亮 2019-03-16
  • 打赏
  • 举报
 回复
暂时还没时间自己操作，但我相信应该没有什么问题！先谢谢您老师！感谢^_^！
milaoshu1020 2019-03-16
  • 打赏
  • 举报
 回复
修改好了,代码:


Sub 生成管段材料表()

    '第1页

    Sheets("全表").Select

    Rows("8:40").Select

    Selection.Copy

    Sheets("管道特性表").Select

    Rows("8:40").Select

    ActiveSheet.Paste

    '清除剪贴板

    Application.CutCopyMode = False

    Application.CommandBars("Task Pane").Visible = False

    

    '清除剪贴板

    Application.CutCopyMode = False

    Application.CommandBars("Task Pane").Visible = False

    

    '第2页

    Dim i As Integer

    Dim j As Integer

    Dim k As Integer

    j = 1

    k = Sheets("操作表格").Range("c4").Value

    For i = 41 To k Step 33 '23 15

        Sheets("全表").Select

        Range(Cells(i, 1), Cells(i + 32, 60)).Select '14

        Selection.Copy

        Sheets("管道特性表").Select

        Range(Cells(i + 8 * j, 1), Cells(i + 8 * j + 32, 60)).Select '26 26 14

        ActiveSheet.Paste

        '清除剪贴板

        Application.CutCopyMode = False

        Application.CommandBars("Task Pane").Visible = False

            

        '清除剪贴板

        Application.CutCopyMode = False

        Application.CommandBars("Task Pane").Visible = False

        j = j + 1

    Next

    Sheets("管道特性表").Select

    ActiveSheet.PageSetup.PrintArea = "$B:$BD"

    Sheets("操作表格").Select

End Sub

示例下载:
链接：https://pan.baidu.com/s/1IcdFgSjbM8O8ELuj0ewCQA
提取码：bc6e
王佰亮 2019-03-16
  • 打赏
  • 举报
 回复
非常感谢您的关注！程序运行倒是可以！但问题是生成出来的第二页表格下半部分没有数据，第三页也是下半部分没有数据，什么问题错误呢？谢谢！
王佰亮 2019-03-16
  • 打赏
  • 举报
 回复
楼上的老师您好！这次运行OK啦！膜拜！^_^还有个问题想请教您：1.为何模板的工作表无法设置密码保护呢，其它工作表都可以？2.工作表生成后如何能自动清空，除了表头外的内容，其余后补充的都能够清除？十分感谢！
milaoshu1020 2019-03-15
  • 打赏
  • 举报
 回复
按照你给的代码,应该没问题啊,你三个按钮从上到下都点一遍,看看有什么问题,告诉我.
王佰亮 2019-03-15
  • 打赏
  • 举报
 回复
链接https://bbs.bccn.net/thread-493607-1-1.html
王佰亮 2019-03-15
  • 打赏
  • 举报
 回复
怎么能提供给您的工作薄链接呢？能否加下您的微信传给您，我的微信是wbailiang 万分感激！
milaoshu1020 2019-03-15
  • 打赏
  • 举报
 回复
1. 数据哪里断了?
2. 要达到你的要求,运行的是哪个过程?怎么运行的?
3. 能不能提供你工作簿的下载链接?这个工作簿好像很复杂,看这些代码直接改的话很难.
VB.NET开发Excel插件实例课程
手把手教您如何快速开发一个属于自己的Excel插件，制作Excel众多功能，办公自动化，高效率办公，开发一个个性化的excel插件。我会从头到尾开始教学，开发过程常遇到什么问题，该如何解决。记录我开发excel插件的案例...
vb/vb.net开发精粹(16)
VB 如何添加 Excel 11 数字金字塔， 如何编写【下载论坛附件】的软件？给个思路，谢谢！ 一个高手的源码，对学打印的人很有帮助 在VB中,STR()函数与STR$()函数有什么区别 VB6如何才能加载Player.swf文件播放...
excel 问题，vba
Excel问题集合
EXCEL难题一网打尽 无意间看到的 转过来 自己看看
也就是，在Excel中，A7单元，能否实现把后面的数字用算式来代替，如A(3+4)，或者是单元格的嵌套，A(D12），恳请高手解答。解答：①=indirect("a"&d12)②我的想法：借一个单元格如B4用，键入="A"&D12 在需引用的单
我在CSDN参与的3000个帖子
2：100分急求，随机输出十个小写字母，但是，要求这十个字母不相同 3：求Sn=a+aa+aaa+…+aaa…a（n个a）之值 4：数组题 望高手帮忙！ 5：呵呵，来推荐一下我的网站，本站提供大量当今流行的免费的音乐和免费电影，...
VB基础类

7,763

社区成员

197,609

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章