Excel VBA – 一覧の操作をするサンプル
ExcelVBAで一覧を操作するサンプルです。

- キーワードを手入力します
- 実行する操作をドロップダウンリストから選択します
- 実行ボタンをクリックします

操作を「抽出」で実行した場合、上記のように抽出対象のF列に、A1セルで設定した「世田谷」という文字を含む行をフィルタします。
Option Explicit
Sub clickSubmit()
Dim strThisbook As String
Dim strSheet As String
Dim strKeyword As String
Dim strAction As String
Dim lngRowNmbr As Long
Dim lngRowNmbr2 As Long
Dim lngRowNmbrM As Long
strThisbook = ThisWorkbook.Name
strSheet = ActiveSheet.Name
strKeyword = Workbooks(strThisbook).Sheets(strSheet).Range("A1")
strAction = Workbooks(strThisbook).Sheets(strSheet).Range("C1")
If strAction = "抽出" Then
' 最終行をもとめます
lngRowNmbr = Workbooks(strThisbook).Sheets(strSheet) _
.Cells(Workbooks(strThisbook).Sheets(strSheet).Rows.Count, 1) _
.End(xlUp)
' フィルタがかかっている場合削除します
If Workbooks(strThisbook).Sheets(strSheet).AutoFilterMode = True Then
Workbooks(strThisbook).Sheets(strSheet) _
.Range("A2:DE" & lngRowNmbr).AutoFilter
End If
' フィルタをかけます
Selection.AutoFilter
ActiveSheet.Range("$A$2:$DE$" & lngRowNmbr) _
.AutoFilter Field:=6, Criteria1:="=*" & strKeyword & "*"
ElseIf strAction = "削除" Then
' 削除対象の行を選んで削除します
lngRowNmbr = 3
Do While Workbooks(strThisbook).Sheets(strSheet) _
.Cells(lngRowNmbr, 1) <> ""
If InStr(1, Workbooks(strThisbook).Sheets(strSheet) _
.Cells(lngRowNmbr, 6), strKeyword) > 0 Then
Workbooks(strThisbook).Sheets(strSheet).Rows(lngRowNmbr) _
.Delete
lngRowNmbr = lngRowNmbr - 1
End If
lngRowNmbr = lngRowNmbr + 1
Loop
ElseIf strAction = "コピー" Then
' 最終行をもとめます
lngRowNmbrM = Workbooks(strThisbook).Sheets(strSheet) _
.Cells(Workbooks(strThisbook).Sheets(strSheet).Rows.Count, 1) _
.End(xlUp)
' コピー対象の行を選んでコピーします
lngRowNmbr = 3
lngRowNmbr2 = lngRowNmbrM + 1
For lngRowNmbr = 3 To lngRowNmbrM
Do While Workbooks(strThisbook).Sheets(strSheet) _
.Cells(lngRowNmbr2, 1) <> ""
lngRowNmbr2 = lngRowNmbr2 + 1
Loop
If InStr(1, Workbooks(strThisbook).Sheets(strSheet) _
.Cells(lngRowNmbr, 6), strKeyword) > 0 Then
Workbooks(strThisbook).Sheets(strSheet) _
.Rows(lngRowNmbr).Select
Selection.Copy
Workbooks(strThisbook).Sheets(strSheet) _
.Rows(lngRowNmbr2).Select
ActiveSheet.Paste
lngRowNmbr2 = lngRowNmbr2 + 1
End If
Next lngRowNmbr
End If
End Sub
サンプルなのに思ったより長くなって焦るやつ(アセ
今後の参考にさせていただきます。
ディスカッション
コメント一覧
まだ、コメントがありません