进入 EXCEL 里的VBA编辑器.插入一个窗口.
增加三个按钮,一个listbox.
CommandButton1 为全选
CommandButton2 为合并
CommandButton3 为退出
程序代码:
Private Sub CommandButton1_Click()
Dim i As Long
'全选
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = True
Next i
End Sub
Private Sub CommandButton2_Click()
Dim obj As Object '合并后的那个表
Dim obj2 As Workbook '合并后的新工作簿
Dim obj3 As Workbook '运行前的活动工作簿
Set obj3 = Application.ActiveWorkbook '保存当前活动工作簿
Set obj2 = Application.Workbooks.Add '增加一个工作簿
Set obj = obj2.Sheets(1) '指定第一个表为合并后的表
'此命令是在当前活动工作簿中增加一个表
'Set obj = obj3.Sheets.Add
'如果是合并后到当前工作簿,则使用增加表命令,
'如果是新的工作簿,则使用增加工作簿命令,再指定工作表
Dim i As Long, j As Long
Dim o As Long, k As Long
'定义表头是第1行
o = 1
'复制表头, 下面的2表示有多少列
For i = 1 To 2
obj.Cells(o, i) = obj3.Sheets(ListBox1.List(0)).Cells(o, i)
Next i
'复制数据
o = o + 1
For j = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(j) Then
k = 2 '数据区起始是第行
'准备读的数据不为空是继续
Do While obj3.Sheets(ListBox1.List(j)).Cells(k, 1) <> ""
For i = 1 To 2 '2表示复制2列
obj.Cells(o, i) = obj3.Sheets(ListBox1.List(j)).Cells(k, i)
Next i
'向下走一行
o = o + 1
k = k + 1
Loop
End If
Next j
MsgBox "合并完成"
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
ListBox1.MultiSelect = fmMultiSelectExtended
'把当前活动的工作薄的工作表列出来
For i = 1 To Application.ActiveWorkbook.Sheets.Count
ListBox1.AddItem Application.ActiveWorkbook.Sheets(i).Name
Next i
End Sub
[
本帖最后由 风吹过b 于 2009-12-1 14:19 编辑 ]