实例19-间隔指定行数插入空行
Private Sub CommandButton处理_Click()
'判断工作簿名，工作表名不为空
With ThisWorkbook.Worksheets("操作界面")
If Trim(.Cells(2, "C").Value) = "" Or Trim(.Cells(6, "C").Value) = "" Or Trim(.Cells(10, "C").Value) = "" _
Or Trim(.Cells(10, "D").Value) = "" Or Trim(.Cells(14, "C").Value) = "" Then
MsgBox "参数不能为空"
Exit Sub
End If
'On Error GoTo 处理出错
'定义变量
Dim wbname As String
Dim shname As String
wbname = Trim(.Cells(2, "C").Value)
shname = Trim(.Cells(6, "C").Value)
Dim splitrow As Long
Dim startnum As Long
Dim stopnum As Long
splitrow = Trim(.Cells(14, "C").Value)
startnum = Trim(.Cells(10, "C").Value)
stopnum = Trim(.Cells(10, "D").Value)
End With
'处理表格
With Workbooks(wbname).Worksheets(shname)
Dim i
For i = stopnum To startnum Step splitrow * (-1)
.Rows(i).Insert
Next i
End With
Workbooks(wbname).Save
MsgBox "处理完成"
Workbooks(wbname).Activate
ActiveWindow.WindowState = xlMaximized
Workbooks(wbname).Worksheets(shname).Activate
Workbooks(wbname).Worksheets(shname).Cells(1, 1).Select
Exit Sub
处理出错:
MsgBox Err.Description
End Sub
实例20-提取多行多列
Private Sub CommandButton提取列_Click()
'判断工作簿名，工作表名不为空
With ThisWorkbook.Worksheets("操作界面")
If Trim(.Cells(2, "C").Value) = "" Or Trim(.Cells(6, "C").Value) = "" Then
MsgBox "参数不能为空"
Exit Sub
End If
'On Error GoTo 处理出错
'定义变量
Dim wbname As String
Dim shname As String
wbname = Trim(.Cells(2, "C").Value)
shname = Trim(.Cells(6, "C").Value)
End With
'清除提取结果
With ThisWorkbook.Worksheets("提取结果")
.UsedRange.ClearFormats
.UsedRange.ClearContents
End With
'处理表格
With Workbooks(wbname).Worksheets(shname)
'循环
Dim i, icount
Dim imax As Long
imax = ThisWorkbook.Worksheets("提取行列号").Cells(1, 10000).End(xlToLeft).Column
icount = 1
For i = 1 To imax
If ThisWorkbook.Worksheets("提取行列号").Cells(1, i) <> "" Then
.Columns(CLng(ThisWorkbook.Worksheets("提取行列号").Cells(1, i))).Copy ThisWorkbook.Worksheets("提取结果").Columns(icount)
icount = icount + 1
End If
Next i
End With
MsgBox "处理完成"
ThisWorkbook.Worksheets("提取结果").Activate
Exit Sub
处理出错:
MsgBox Err.Description
End Sub
Private Sub CommandButton提取行_Click()
'判断工作簿名，工作表名不为空
With ThisWorkbook.Worksheets("操作界面")
If Trim(.Cells(2, "C").Value) = "" Or Trim(.Cells(6, "C").Value) = "" Then
MsgBox "参数不能为空"
Exit Sub
End If
'On Error GoTo 处理出错
'定义变量
Dim wbname As String
Dim shname As String
wbname = Trim(.Cells(2, "C").Value)
shname = Trim(.Cells(6, "C").Value)
End With
'清除提取结果
With ThisWorkbook.Worksheets("提取结果")
.UsedRange.ClearFormats
.UsedRange.ClearContents
End With
'处理表格
With Workbooks(wbname).Worksheets(shname)
'循环
Dim i, icount
Dim imax As Long
imax = ThisWorkbook.Worksheets("提取行列号").Cells(1000000, 1).End(xlUp).Row
icount = 1
For i = 1 To imax
If ThisWorkbook.Worksheets("提取行列号").Cells(i, 1) <> "" Then
.Rows(CLng(ThisWorkbook.Worksheets("提取行列号").Cells(i, 1))).Copy ThisWorkbook.Worksheets("提取结果").Rows(icount)
icount = icount + 1
End If
Next i
End With
MsgBox "处理完成"
ThisWorkbook.Worksheets("提取结果").Activate
Exit Sub
处理出错:
MsgBox Err.Description
End Sub
