實(shí)例19-間隔指定行數(shù)插入空行

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 "參數(shù)不能為空"

Exit Sub

End If

'On Error GoTo 處理出錯(cuò)

'定義變量

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

處理出錯(cuò):

MsgBox Err.Description

End Sub

實(shí)例20-提取多行多列

Private Sub CommandButton提取列_Click()

'判斷工作簿名，工作表名不為空

With ThisWorkbook.Worksheets("操作界面")

If Trim(.Cells(2, "C").Value) = "" Or Trim(.Cells(6, "C").Value) = "" Then

MsgBox "參數(shù)不能為空"

Exit Sub

End If

'On Error GoTo 處理出錯(cuò)

'定義變量

Dim wbname As String

Dim shname As String

wbname = Trim(.Cells(2, "C").Value)

shname = Trim(.Cells(6, "C").Value)

End With

'清除提取結(jié)果

With ThisWorkbook.Worksheets("提取結(jié)果")

.UsedRange.ClearFormats

.UsedRange.ClearContents

End With

'處理表格

With Workbooks(wbname).Worksheets(shname)

'循環(huán)

Dim i, icount

Dim imax As Long

imax = ThisWorkbook.Worksheets("提取行列號(hào)").Cells(1, 10000).End(xlToLeft).Column

icount = 1

For i = 1 To imax

If ThisWorkbook.Worksheets("提取行列號(hào)").Cells(1, i) <> "" Then

.Columns(CLng(ThisWorkbook.Worksheets("提取行列號(hào)").Cells(1, i))).Copy ThisWorkbook.Worksheets("提取結(jié)果").Columns(icount)

icount = icount + 1

End If

Next i

End With

MsgBox "處理完成"

ThisWorkbook.Worksheets("提取結(jié)果").Activate

Exit Sub

處理出錯(cuò):

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 "參數(shù)不能為空"

Exit Sub

End If

'On Error GoTo 處理出錯(cuò)

'定義變量

Dim wbname As String

Dim shname As String

wbname = Trim(.Cells(2, "C").Value)

shname = Trim(.Cells(6, "C").Value)

End With

'清除提取結(jié)果

With ThisWorkbook.Worksheets("提取結(jié)果")

.UsedRange.ClearFormats

.UsedRange.ClearContents

End With

'處理表格

With Workbooks(wbname).Worksheets(shname)

'循環(huán)

Dim i, icount

Dim imax As Long

imax = ThisWorkbook.Worksheets("提取行列號(hào)").Cells(1000000, 1).End(xlUp).Row

icount = 1

For i = 1 To imax

If ThisWorkbook.Worksheets("提取行列號(hào)").Cells(i, 1) <> "" Then

.Rows(CLng(ThisWorkbook.Worksheets("提取行列號(hào)").Cells(i, 1))).Copy ThisWorkbook.Worksheets("提取結(jié)果").Rows(icount)

icount = icount + 1

End If

Next i

End With

MsgBox "處理完成"

ThisWorkbook.Worksheets("提取結(jié)果").Activate

Exit Sub

處理出錯(cuò):

MsgBox Err.Description

End Sub