先說明下:原表格是分上下兩塊,原表格上部分中標題欄占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


uj5u.com熱心網友回復:
1. 資料哪里斷了?2. 要達到你的要求,運行的是哪個程序?怎么運行的?
3. 能不能提供你作業簿的下載鏈接?這個作業簿好像很復雜,看這些代碼直接改的話很難.
uj5u.com熱心網友回復:
怎么能提供給您的作業薄鏈接呢?能否加下您的微信傳給您,我的微信是wbailiang 萬分感激!uj5u.com熱心網友回復:
鏈接https://bbs.bccn.net/thread-493607-1-1.htmluj5u.com熱心網友回復:
按照你給的代碼,應該沒問題啊,你三個按鈕從上到下都點一遍,看看有什么問題,告訴我.uj5u.com熱心網友回復:
非常感謝您的關注!程式運行倒是可以!但問題是生成出來的第二頁表格下半部分沒有資料,第三頁也是下半部分沒有資料,什么問題錯誤呢?謝謝!uj5u.com熱心網友回復:
修改好了,代碼:
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
uj5u.com熱心網友回復:
暫時還沒時間自己操作,但我相信應該沒有什么問題!先謝謝您老師!感謝^_^!uj5u.com熱心網友回復:
樓上的老師您好!這次運行OK啦!膜拜!^_^還有個問題想請教您:1.為何模板的作業表無法設定密碼保護呢,其它作業表都可以?2.作業表生成后如何能自動清空,除了表頭外的內容,其余后補充的都能夠清除?十分感謝!uj5u.com熱心網友回復:
第一個問題已解決了,麻煩第二個問題求答案,謝謝!uj5u.com熱心網友回復:
這樣: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
轉載請註明出處,本文鏈接:https://www.uj5u.com/gongcheng/36925.html
標籤:VB基礎類
下一篇:用VB6.0畫圓形按鈕。
