ExcelVBAです。


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

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

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

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

宜しくお願いします。

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2008/06/10 22:12:52
  • 終了:2008/06/10 22:49:48

ベストアンサー

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/06/10 22:32:45

ポイント27pt

サンプルです。


①行の挿入

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

id:hananeko_0

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

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

2008/06/10 22:48:03

その他の回答(2件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/06/10 22:32:45ここでベストアンサー

ポイント27pt

サンプルです。


①行の挿入

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

id:hananeko_0

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

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

2008/06/10 22:48:03
id:taknt No.2

きゃづみぃ回答回数13537ベストアンサー獲得回数11982008/06/10 22:34:42

ポイント27pt

① 当然ながら 挿入していくときに 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

id:hananeko_0

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

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

2008/06/10 22:48:18
id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692008/06/10 22:38:02

ポイント26pt

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/

id:hananeko_0

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

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

2008/06/10 22:48:23
  • id:taknt
    上から 3行連続して けしごむ が入っている場合、どうなればいいでしょうか?
  • id:SALINGER
    そうなってないように祈るかな。
    下から削除してくと、2行けしごむが続いてると消さない行が出るような・・・。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません