Excelのマクロに関して質問致します。


各ファイルのシートのサンプルイメージはこちら。
http://pub.idisk-just.com/fview/Q222eBLbJYUapI4Tt4KndsBhjuPA1pnmyzkHN9F-81EfmyprhtI6pKyXtBNtO66C/44OX44Os44K844Oz44OG44O844K344On44OzMQ.jpg

---前提---
【1】シート内容ですが、1行目と2行目は項目として使われています。
   3行目からX行目(ファイルにより異なる)はデータが投入されています。

   サンプルイメージではA列とB列しかないように見えますが、
   実際にはA列からEH列まであります。
   
【2】このようなExcelのファイルが200以上あります。

---組みたいマクロ---
B列の3行目以降に「要2008」と入っていたら、その行はまるまる残し、
それ以外の行は全て削除(クリアではない)したい。
200以上のファイルを個別に手作業で実施するのは大変なため、
マクロを組みたい。
(全部のファイルを連結して1回で処理する、というような方法は除外
 してください。個別に200回以上繰り返します)

うまい記述内容が思いつかなく、質問致します。

宜しくお願いします。

回答の条件
  • 1人2回まで
  • 登録:2008/04/02 14:51:18
  • 終了:2008/04/05 03:09:48

回答(2件)

id:nyankochan No.1

nyankochan回答回数323ベストアンサー獲得回数92008/04/02 17:32:02

ポイント35pt

個別のファイルで200回繰り返すと言うことであれば・・・

Sub Macro1()

i = 1

x = Cells(i, 2)

Do While Cells(i, 1) <> ""

If x = "" Then

Cells(i, 1).Select

Selection.EntireRow.Delete

i = 1

End If

i = i + 1

x = Cells(i, 2)

Loop

Range("A1").Activate

End Sub


な感じでどうでしょうか。

行の削除を行った際に iの数値が行ズレを起こすので

1行目から再確認にいかせています。

ただ、縦に1000行とかある場合は時間がかかったりしますので、

一気に空行のチェックをさせて、空行の同時選択をしてのデリートアクションを

させたほうが良いような気もします。

ということでそっち系のも・・・・


Sub Macro2()

i = 1

x = Cells(i, 2)

Do While Cells(i, 1) <> ""

If x = "" Then

If y <> "" Then

y = y + ","

End If

y = y + "A" & i

End If

i = i + 1

x = Cells(i, 2)

Loop

Range(y).Select

Selection.EntireRow.Delete

Range("A1").Select

End Sub


お好きな方をお使いください。

id:miku1973

オープン遅くなりました。やってみます!ありがとうございます!

2008/04/05 03:05:53
id:beatgoeson No.2

beatgoeson回答回数128ベストアンサー獲得回数142008/04/02 15:49:52

ポイント35pt

下記のようなVBAでいかがでしょうか。

変数 strFolderPath の値はご自身の環境に合わせて変更してください。

2,3のファイルで試してから実行してください。

実行前にファイルのバックアップはとっておいてください。

これにより間違って保存されても保障しかねますので。

A列にはないか値が入ってるという前提です。もしA列が空の行があるとその前で処理が終わってしまうので、A列が空の場合は、適宜下記のVBAを修正してください。

--------------------------------

Sub UpdateFiles()


Dim strFolderPath As String

Dim strFindFile As String

Dim strTargetFile As String

Dim strBookName As String

Dim lrow As Long

strFolderPath = "C:\temp\test\"

strFindFile = "*.xls"

strTargetFile = Dir(strFolderPath & strFindFile)

Do While strTargetFile <> ""

Workbooks.Open (strFolderPath & strTargetFile)

strBookName = ActiveWorkbook.Name

lrow = 3

Do While ActiveSheet.Cells(lrow, 1) <> ""

If ActiveSheet.Cells(lrow, 2) <> "要2008" Then

Rows(lrow).Select

Selection.Delete Shift:=xlUp

Else

lrow = lrow + 1

End If

Loop

Workbooks(strBookName).Close True

strTargetFile = Dir

Loop

End Sub

id:miku1973

ありがとうございます!やってみます!

2008/04/05 03:09:34

コメントはまだありません

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

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

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

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