人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

ExcelVBAです。

分厚い参考書を見ても、イマイチ載っておらず・・・
教えていただくと助かります。

?A列に「えんぴつ」という文字列のセルがあれば、その一行上に
行を一行挿入する

?A列に「けしごむ」という文字列のセルがあれば、その一行上の行を
行ごと削除する

?アクティブシート以外のシートを全て削除する

宜しくお願いします。

●質問者: hananeko_0
●カテゴリ:ビジネス・経営 コンピュータ
✍キーワード:アクティブ イマイチ セル 参考書 文字列
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● Mook
●27ポイント ベストアンサー

サンプルです。


?行の挿入

Sub AddPencil()
 Dim lastRow As Long
 lastRow = Range("A" & Rows.Count).Row
 For i = lastRow To 1 Step -1
 If Cells(i, "A").Value = "えんぴつ" Then
 Rows(i).Insert shift:=xlDown
 End If
 Next
End Sub

http://www.geocities.jp/happy_ngi/YNxv204.html


?行の削除

Sub delEraser()
 Dim lastRow As Long
 lastRow = Range("A" & Rows.Count).Row - 1
 For i = lastRow To 1 Step -1
 If Cells(i + 1, "A").Value = "けしごむ" Then
 Rows(i).Delete shift:=xlUp
 i = i - 1
 End If
 Next
End Sub

?シートの削除

Sub delOtherSheets()
 Dim ws As Worksheet
 Application.DisplayAlerts = False
 For Each ws In Worksheets
 If ws.Name <> ActiveSheet.Name Then
 ws.Delete
 End If
 Next
 Application.DisplayAlerts = True
End Sub

http://officetanaka.net/excel/vba/file/file03.htm

◎質問者からの返答

解決しました!素晴らしいですっ!

本当にありがとうございました。


2 ● きゃづみぃ
●27ポイント

? 当然ながら 挿入していくときに 65536行を超えれば エラーとなります。

Dim b As Long
b = 1
For a = 1 To 65535
 If Cells(b, "A") = "えんぴつ" Then Rows(b).Insert Shift:=xlDown: b = b + 1
 b = b + 1
 If b = 65537 Then Exit For
Next a

?一行目は 削除するところが ないから 二行目から処理します。

Dim b As Long

b = 2
For a = 2 To 65536
 If Cells(b, "A") = "けしごむ" Then Rows(b - 1).Delete Shift:=xlUp: b = b - 1
 b = b + 1
 If b = 65537 Then Exit For
Next a

?

ActiveSheet.Move Before:=Sheets(1)
Application.DisplayAlerts = False
For a = Worksheets.Count To 2 Step -1
 Worksheets(a).Delete
Next a
Application.DisplayAlerts = True

http://q.hatena.ne.jp/answer

◎質問者からの返答

解決しました!素晴らしいですっ!

本当にありがとうございました。


3 ● SALINGER
●26ポイント

?

Sub test1()
 Dim i As Long
 Dim j As Long
 Dim lastRow As Long
 
 lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
 j = 0
 For i = 1 To lastRow + j
 If ActiveSheet.Cells(i, 1).Value = "えんぴつ" Then
 ActiveSheet.Rows(i).Insert Shift:=xlDown
 i = i + 1
 j = j + 1
 End If
 Next i
End Sub

?

Sub test2()
 Dim i As Long
 Dim j As Long
 Dim lastRow As Long
 
 lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
 j = 0
 For i = 1 To lastRow - j
 If ActiveSheet.Cells(i, 1).Value = "けしごむ" Then
 ActiveSheet.Rows(i - 1).Delete Shift:=xlUp
 i = i - 1
 j = j + 1
 End If
 Next i
End Sub

?

Sub test3()
 Dim w As Worksheet
 Application.DisplayAlerts = False
 For Each w In Worksheets
 If w.Name <> ActiveSheet.Name Then
 w.Delete
 End If
 Next
 Application.DisplayAlerts = True
End Sub

http://q.hatena.ne.jp/

◎質問者からの返答

解決しました!素晴らしいですっ!

本当にありがとうございました。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ