Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1558 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

▼

【73544】表整理 コーヒー牛乳 13/1/20(日) 14:24

【73545】Re:表整理 kanabun 13/1/20(日) 15:01

【73546】Re:表整理 コーヒー牛乳 13/1/20(日) 16:17

【73547】Re:表整理 UO3 13/1/20(日) 16:35

【73548】Re:表整理 コーヒー牛乳 13/1/20(日) 17:04

【73549】Re:表整理 UO3 13/1/20(日) 17:49

【73550】Re:表整理 コーヒー牛乳 13/1/20(日) 17:59

【73551】Re:表整理 kanabun 13/1/20(日) 19:56

【73552】Re:表整理 コーヒー牛乳 13/1/20(日) 20:34


	【73544】表整理

コーヒー牛乳 - 13/1/20(日) 14:24 -


	引用なし

	パスワード

表の整理について質問があります。

整理前の表
　
　　 A　　　 B　　　 C　　　 D 　　　E
1　みかん　バナナ　りんご　いちご　　
2　１０円　２０円　３０円　４０円

このような表があります。「りんご」と「みかん」を条件にして表を整理したいと思います。

整理後の表

みかん　りんご　
１０円　３０円

ただし、みかんが常に「A１」　バナナが常に「B1」に来るとは限りませんので、
見出しの言葉を抽出のキーワードにしたいと思いました。

そこで以下のようなプログラムを書きました。

Sub 表整理()

Range("a1").Select
　
sento:

　Select Case ActiveCell
　
　　　　 Case Is = "": End

　　　　 Case Is = "りんご": ActiveCell.Offset(0, 1).Select
　　　　　　
　　　　　　　　　　GoTo sento

　　　　 Case Is = "みかん": ActiveCell.Offset(0, 1).Select

　　　　　　　　　　GoTo sento
　　　　
　　　　 Case Else: ActiveCell.EntireColumn.Select
　　　　
　　　　　　　　　　Selection.Delete
　　　　　　　　　
　　　　　　　　　　ActiveCell.Offset(0, 0).Select
　　　　　　　　　　　
　　　　　　　　　　GoTo sento
　
　End Select
　

End Sub

一応、結果は得られるのですが、正直、自分のVBAの能力の未熟さを感じています。
一つはデーターが多くなると処理が遅くなることもありますが、なによも、
オートフィルターを使うなり、配列を使うなり、何か別の形でのプログラムの
方がふさわしいのではないか、と感じています。

ですが、なかなか思い浮かびません。

そこでこのようなデーターベースを処理するにふさわしいVBAの書き方をお教えいただけないものでしょうか。

一つに限らず、複数あれば、それだけ勉強になるので、
私の技術の向上になにとぞご協力ください。お願いいたします。


	【73545】Re:表整理

kanabun - 13/1/20(日) 15:01 -


	引用なし

	パスワード

▼コーヒー牛乳さん： >「りんご」と「みかん」一行目を挿入して、そこに、2行目が「りんご」または「みかん」だったら 1を、そうでなかったら False を返す数式を書き込みます。あとは、コードを読んでもらえば、分かると思います。(^^ Sub Try1() 　　Rows(1).Insert 　　With Range("A2", Cells(2, Columns.Count).End(xlToLeft)).Offset(-1) 　　　　.Formula = _ 　　　　　　　"=IF(OR(A2=""りんご"",A2=""みかん""),1,FALSE)" 　　　　On Error Resume Next 　　　　.SpecialCells(xlFormulas, xlLogical).EntireColumn.Delete 　　　　On Error GoTo 0 　　End With 　　Rows(1).Delete 　　　　 End Sub


	【73546】Re:表整理

コーヒー牛乳 - 13/1/20(日) 16:17 -


	引用なし

	パスワード

▼kanabun さん：

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

.SpecialCells(xlFormulas, xlLogical).EntireColumn.Delete

数字の列は残して、論理値の列だけを消す、というテクニックを知れてよかったです。

find what、検索、抽出、色々自分なりに考えてみたのですが、うまくゆかず、自分なりに考えたプログラムが一番最初のプログラムだったのですが、お教えいただいたプログラムはシンプルで、しかも効果的で大変勉強になりました！

ありがとうございます。


	【73547】Re:表整理

UO3 - 13/1/20(日) 16:35 -


	引用なし

	パスワード

▼コーヒー牛乳さん：

こんにちは

ご自身で「オートフィルターを使うなり、配列を使うなり」と書いておられるように、
この処理ですと、「フィルターオプション」が最適ではないでしょうか。

たとえば G1から右に抽出したいタイトル（みかん　や　りんご）をいくつでも抽出したい順番に
記入しておきます。かりにG1とF1の２つに書いたとします。
（動的に、いくつあるかを判断できますがわかりやすくするために２つだけだとしましょう）

で、2003までなら　データ->フィルターオプション、
2007以降ならデータメニューのフィルターグループの詳細設定。

でてきたダイアログで

リスト範囲(L) A:F
指定した範囲(O) を選んで　抽出範囲(T) に　G1:H1
OK ボタン

これで、G列、F列に目的のものが抽出されます。

必要なら A:F列を削除してもよろしいですね。

★この一連の操作をマクロ記録しますと、コードが生成されます。
　

で、それとは別に、一般的なコード処理としては、アップされたコード、いささか改善の余地はありますね。
・ループ制御の中でGoToを使うのは感心しません。
・処理すべきセル等をSelectして、Selection.○○○　とするのも感心しません。

アップされたように１行目の値を判定して列削除するにしても、以下のようなコードにされるほうが
よろしいかと思います。

Sub Sample()
　　Dim maxCol As Long
　　Dim j As Long
　　
　　'最終列番号の取得
　　maxCol = Range("A1").CurrentRegion.Columns.Count
'　または
'　　maxCol = Cells(1, Columns.Count).End(xlToLeft).Column
'　または
'　　maxCol = Range("A1").End(xlToRight).Column
　　
　　For j = maxCol To 1 Step -1
　　　　Select Case Cells(1, j).Value
　　　　　　Case "りんご", "みかん"
　　　　　　Case Else
　　　　　　　　Columns(j).Delete
　　　　End Select
　　Next
　　　　　　
End Sub


	【73548】Re:表整理

コーヒー牛乳 - 13/1/20(日) 17:04 -


	引用なし

	パスワード

▼UO3 さん：

実際に私のコードの問題点を指摘してくださいまして、ありがとうございます。

そうなんです、実際にセレクトして、何かさせる、というのは
自分でも悪い癖だなと思っています。

実際、処理も重くなりますし。

Select Case Cells(1, j).Value

この部分は、何でもアクティブセルで処理していた私には、
今まで全くなかった発想なので大変勉強になりました。

ちなみに、
　　　　　　Case "りんご", "みかん"

ここの意味は　りんご、みかん、のときは何も処理しないという意味にとってよろしいのでしょうか。

今まで、りんご、みかんのときは何かをしなさい（たとえばアクティブセルを横をに動かせ）と書いていた自分には、Case "りんご", "みかん"　だけの意味が少しわかりづらいのでお教えください。

よろしくお願いいたします。


	【73549】Re:表整理

UO3 - 13/1/20(日) 17:49 -


	引用なし

	パスワード

▼コーヒー牛乳さん：

>ここの意味は　りんご、みかん、のときは何も処理しないという意味にとってよろしいのでしょうか。

はい、そうですね。
ちょっとかっこわるいというか無理矢理な記述かもですね。

以下のほうがわかりやすいでしょうか？

Sub Sample2()
　　Dim maxCol As Long
　　Dim j As Long
　　
　　'最終列番号の取得
　　maxCol = Range("A1").CurrentRegion.Columns.Count
'　または
'　　maxCol = Cells(1, Columns.Count).End(xlToLeft).Column
'　または
'　　maxCol = Range("A1").End(xlToRight).Column
　
　　For j = maxCol To 1 Step -1
　　　　Select Case True
　　　　　　Case Cells(1, j).Value <> "りんご" And Cells(1, j).Value <> "みかん"
　　　　　　　　Columns(j).Delete
　　　　End Select
　　Next
　　　
End Sub

Sub Sample3()
　　Dim maxCol As Long
　　Dim j As Long
　　
　　'最終列番号の取得
　　maxCol = Range("A1").CurrentRegion.Columns.Count
'　または
'　　maxCol = Cells(1, Columns.Count).End(xlToLeft).Column
'　または
'　　maxCol = Range("A1").End(xlToRight).Column
　
　　For j = maxCol To 1 Step -1
　　　　If Cells(1, j).Value <> "りんご" And Cells(1, j).Value <> "みかん" Then Columns(j).Delete
　　Next
　　　
End Sub


	【73550】Re:表整理

コーヒー牛乳 - 13/1/20(日) 17:59 -


	引用なし

	パスワード

▼UO3 さん：

select caseで、
何も処理させたくないときは、何も処理を書かないでいい、
というのは今日初めて知りました。
今後使えるテクニックだと思うので、
一度意味を理解すれば、とっても分かりやすいです。
親切な解説本当にありがとうございました。
早速明日、会社で使わせていただきます。


	【73551】Re:表整理

kanabun - 13/1/20(日) 19:56 -


	引用なし

	パスワード

▼コーヒー牛乳さん： >select caseで、 >何も処理させたくないときは、何も処理を書かないでいい、 >というのは今日初めて知りました。 >今後使えるテクニックだと思うので、そのとおりです。さらに言えば（私的には）　　　　Select Case True 　　　　　　Case セル.Value <> "りんご" And セル.Value <> "みかん" 　　　　　　　　'処理　　　　End Select よりも、　　　　Select Case セル.Value 　　　　　　Case "りんご", "みかん" 　　　　　　　　'何もしない　　　　　　Case Else 　　　　　　　　'処理　　　　End Select のほうが数段スマートな書き方といえます。たとえばセルの値が「りんご」のとき、前者は、And のまえのセル.Value <> "りんご" 文節が成立しない(False)からその時点で Case文全体の評価は「False」と分かるはずで、 Andのうしろのセル.Value <> "みかん" 部分を評価する必要はないはずです。にもかかわらずVBAでは、And を使うと、And の前が False のときでも Andの後ろも真偽判断する、どんくさい仕様になってます。後者ならば、セルの値が "りんご" だったら、"みかん"であるかの評価はしませんので。


	【73552】Re:表整理

コーヒー牛乳 - 13/1/20(日) 20:34 -


	引用なし

	パスワード

▼kanabun さん：

おっしゃる通り、

Select Case セル.Value
　　　　　　Case "りんご", "みかん"
　　　　　　　　'何もしない
　　　　　　Case Else
　　　　　　　　'処理
　　　　End Select

これはめちゃくちゃ、わかりやすいです。

kanabunさんに教えていただいた、数字と論理値で列を選択削除するテクニックも
本当にびっくりさせられました。

同じ結果の出る処理でも、人ぞれぞれの発想で、色々とやり方があるんだな、と感心しました。私のも、今ある私の知識で最大限考えた結果ですので、それはそれでいいのですが、なにぶん、データ量が多いと、自分が思っていたよりも処理に時間がかかってしまいました。そこでVBA熟練者のお二人の意見をうかがえて、本当に勉強になりました。

kanabunさん　UO3さん、本当にありがとうございました。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1558 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free