不要行を削除したい

質問

『B列のとあるセルに「あああ」と入力されているなら
B1から「あああ」の一つ上の行まで削除する』というコードが知りたいです。

なので例えば
「あああ」がB100に入力されているとしたら
1行目から99行目まで削除して「あああ」を「B1」に持ってくるようにしたいです。

よろしくお願いします。

回答No.9

imogasi · ベストアンサー

こんなところへ質問するよりマクロの記録をなぜとって見ないのですか。
それをみて変えるべきところ、変え方を勉強してこそ、力が付くのです。
ーー
＞B列のとあるセルに「あああ」と入力されているなら
B1から「あああ」の一つ上の行まで削除する』というコードが知りたいです
と
＞「あああ」がB100に入力されているとしたら
1行目から99行目まで削除して「あああ」を「B1」に持ってくるようにしたいです
は内容が違うのではないですか。質問表現はしっかり。
ーー
マクロの記録をとると
Sub Macro1()

Columns("B:B").Select
Selection.Find(What:="あああ", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
Range("B1:B6").Select
Range("B6").Activate
Selection.Delete Shift:=xlUp
End Sub
ここで問題はB6が実際では変わる。そこで
（Selectionなどマクロの冗長さを取り去り、）「あああ」の発見行番号を捉えるように改良して
Sub Macro1()

r = Columns("B:B").Find(What:="あああ", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False).Row
MsgBox r
Range("B1:B" & r).Select
Selection.Delete Shift:=xlUp
End Sub
とする。
ーー
Selection.Delete Shift:=xlUp
はセルの削除だが行の削除なら、WEBで
「エクセルVBA　行の削除」で照会のこと。
http://www.k1simplify.com/vba/tipsleaf/leaf238.html
--
Sub Macro1()
Columns("B:B").Select
r = Selection.Find(What:="あああ", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False).Row

Rows("1:" & r).Delete
End Sub

お礼

もっと勉強してがんばります。大変参考になりました。ご回答ありがとうございます。

回答No.8

noname#79209

#2です。
ゴメンナサイ。#7だと、1行目に見つかったときエラーになります。
以下に修正。

Sub Test()
Dim lngYLine As Long
Dim Obj As Object

Set Obj = Cells.Find("あああ")
If Obj Is Nothing Then
MsgBox "「あああ」は見つかりませんでした。 "
Else
lngYLine = Cells.Find("あああ").Row - 1
If lngYLine > 0 Then
Rows("1:" & lngYLine).Select
Selection.Delete Shift:=xlUp
Range("A1").Select
End If
End If
Set Obj = Nothing
End Sub

お礼

大変参考になりました。ご回答ありがとうございます。

回答No.7

noname#79209

#2です。

Sub Test()
Dim lngYLine As Long
Dim Obj As Object

Set Obj = Cells.Find("あああ")
If Obj Is Nothing Then
MsgBox "「あああ」は見つかりませんでした。 "
Else
lngYLine = Cells.Find("あああ").Row - 1
Rows("1:" & lngYLine).Select
Selection.Delete Shift:=xlUp
Range("A1").Select
End If
Set Obj = Nothing
End Sub

お礼

大変参考になりました。ご回答ありがとうございます。

回答No.6

merlionXX

VBAがお望みならこんな感じでしょうか。

Sub test01()
On Error GoTo line
x = Application.WorksheetFunction.Match("あああ", Columns("B:B"), 0)
If x = 1 Then
Exit Sub
Else
Rows("1:" & x - 1).Delete
End If
Exit Sub
line:
MsgBox "見当たりません", vbCritical, "Σ（￣ロ￣lll) "
End Sub

お礼

できました！
ご回答ありがとうございます。

回答No.5

mohenjo

No.4です。
申し訳ありません。

「あああ」以外を空白行と勘違いしていました。
無視して下さい。

お礼

ご回答ありがとうございます。

回答No.4

mohenjo

ご参考に！

Sub test()
Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

お礼

ご回答ありがとうございます。

回答No.3

noname#79209

#2です。
「あああ」以降の行も生かすのならダメですね。忘れてください。

お礼

ご丁寧にありがとうございます。

回答No.2

noname#79209

荒技ですが、
１．「編集」－「検索」で「あああ」を探し、見つかったらその行全体を選択してコピー。
２．左上の列番号と行番号の交差する四角形をクリックして、シート全体を選択し、「DEL」キーを押して全て削除。
３．1行目全体を選択して、ぺースト

> コードが知りたいです。
と言われているので、「VBAでかな？」とも思いましたが、ご参考まで．．．

お礼

ご回答ありがとうございます。

回答No.1

hayasi456

一般的な方法ですが
B1で左クリックB99で「Shift」キーを押しながら左クリック選択した範囲内で右クリック削除を選択
これでいかがですか？

お礼

ご回答ありがとうございます。
このような状況が何度も出てくるので自動化できるようにマクロを組みたいのですが。。。
よろしくお願いします。