想在VB加入一个按钮执行表格汇总程序，加入按钮后不知道如何编写代码调用程序执行，请帮忙修改一下，谢谢！

zyqballack2008 2025-04-03 23:51:56

VB中想增加一个按钮来执行以下程序，执行报错无法调用，请帮忙修改一下程序，感谢！

Private Sub CommandButton1_Click()
MergeSheetsFullData

End Sub

Sub MergeSheetsFullData()
Dim ws As Worksheet
Dim target As Worksheet
Dim sourceLastRow As Long, sourceLastCol As Integer
Dim targetLastRow As Long

' 设置目标为"汇总"Sheet（需提前创建）
Set target = ThisWorkbook.Sheets("汇总")
Application.ScreenUpdating = False

' 清除旧数据（保留标题行）
If target.UsedRange.Rows.Count > 1 Then
target.Range("A2", target.Cells.SpecialCells(xlCellTypeLastCell)).ClearContents
End If

' 遍历所有Sheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> target.Name Then
' 动态获取源数据范围
sourceLastRow = GetLastRow(ws) ' 获取实际最后一行
sourceLastCol = GetLastColumn(ws) ' 获取实际最后一列

If sourceLastRow > 1 And sourceLastCol > 0 Then
' 构建动态数据范围（A2到最后一列最后一行的矩形区域）
With ws.Range(ws.Cells(2, 1), ws.Cells(sourceLastRow, sourceLastCol))
' 获取目标粘贴起始位置
targetLastRow = target.Cells(target.Rows.Count, 1).End(xlUp).Row + 1
If targetLastRow = 2 And target.Range("A1").Value = "" Then targetLastRow = 1

' 精准复制（值+格式）
.Copy
target.Cells(targetLastRow, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
End If
End If
Next ws

Application.ScreenUpdating = True
MsgBox "合并完成！共处理 " & ThisWorkbook.Sheets.Count - 1 & " 个Sheet", vbInformation
End Sub

' 获取实际最后一行（考虑所有列）
Function GetLastRow(ws As Worksheet) As Long
On Error Resume Next
GetLastRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
If Err.Number <> 0 Then GetLastRow = 1
On Error GoTo 0
End Function

' 获取实际最后一列（考虑所有行）
Function GetLastColumn(ws As Worksheet) As Integer
On Error Resume Next
GetLastColumn = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
If Err.Number <> 0 Then GetLastColumn = 1
On Error GoTo 0
End Function
End Function

End Sub

...全文