Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6900 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【42049】条件数の変化 もとあし 06/8/30(水) 13:38 質問[未読]
【42058】Re:条件数の変化 りん 06/8/30(水) 18:00 回答[未読]
【42116】Re:条件数の変化 もとあし 06/9/1(金) 15:08 お礼[未読]
【42264】Re:条件数の変化 もとあし 06/9/5(火) 10:55 質問[未読]
【42271】Re:条件数の変化 Kein 06/9/5(火) 11:56 回答[未読]
【42453】Re:条件数の変化 もとあし 06/9/12(火) 15:22 お礼[未読]
【42049】条件数の変化
質問  もとあし  - 06/8/30(水) 13:38 -
引用なし
パスワード
   いつも皆さんには投稿以外にも過去ログなどでも
助けていただいてます。ありがとうございます♪
初心者なので、こちらのサイトは欠かせないものとなっています☆

今回教えていただきたいことは・・・
1つのシートに2つの基本的な構造が似ている横並びの２つの表があります。
ただしその表の扱うモノが少し異なります。
例えば表１は「食品」で表２は「雑貨」とします。

表には備考欄があり、そこの最初には必要に応じて
指定Keywordを入力することになっています。
そのKeywordを元にリストの該当行を別のブックへコピーする処理を
作成したいのです。
ところが、表１と表２ではいくつかあるKeywordの数と内容が少し異なります。
例えば表１のKeywordが「不要」「必要」「賞味期限」と３つあった場合、
表２のKeywordは「不要」「必要」のみの２つであったとします。

まず表１のみに対して次のようなコードを書きました。

For i = 7 To n '7行目からCells.End(xlUp).Rowで得た最終行まで
　If (Left(Cells(i, 12).Value, 2) = "不要" Or _
　　　Left(Cells(i, 12).Value, 2) = "必要" Or _
　　　Left(Cells(i, 12).Value, 4) = "賞味期限" Then　　　　
　　　　For z = 2 To 12 'B列〜L列までのセル
　　　　　　Cells(i, z).Copy _
　　　　　　Destination:=Workbooks("wb").Sheets("sheet1").Cells(x, z)
　　　　Next z
　End If
Next i

（実際のコードを上記の例題用に変えただけで、上記は検証してないのですが、
実際のコードはきちんと動作します。）

1つのプロシージャー内で表１と表2からの抽出をいっぺんに行いたいたく、
しかも同じようなコードを何回も書きたくないので、
上記コードを別のSubでまとめ、表2にも対応できるようにし、
最近学習したCallステートメントで表1用、表2用に変数に値を指定し、
2度呼び出せるかな？と試行錯誤中ですが、
If()Thenをどうしたらいいのか一向に分からず、投稿しました。

すみません。どなたか助けてください。
（説明下手たので、意味が？？？でしたらご指摘ください！）
よろしくお願いします。
【42058】Re:条件数の変化
回答  りん E-MAIL  - 06/8/30(水) 18:00 -
引用なし
パスワード
   もとあし さん、こんばんわ。

>ところが、表１と表２ではいくつかあるKeywordの数と内容が少し異なります。
>例えば表１のKeywordが「不要」「必要」「賞味期限」と３つあった場合、
>表２のKeywordは「不要」「必要」のみの２つであったとします。
 ダミーコードのようなので、実際はいくつの分岐があるのかはしりませんが、判断の部分を関数として分離してみました。

sub なんとか()
>For i = 7 To n '7行目からCells.End(xlUp).Rowで得た最終行まで
　 With Application.ActiveSheet
　 If tp1(.Cells(i, 12).Value, 3) = True Then
>　　　'B列〜L列までのセルを転記
　　　　.Range(.Cells(i, 2), .Cells(i, 12)).Copy _
　　　　Destination:=Workbooks("wb").Sheets("sheet1").Cells(x, 2)
>　End If
　 End With
>Next i
・・・・
End Sub
'判定する関数
関数tp1 arg1:判定基準の文字列, NN:チェックするキーワードの数（上限）
Function tp1(arg1 As String, NN As Integer) As Boolean
　 Dim flg As Boolean, s1 As Variant, II As Integer, Imax As Integer
　 s1 = Array("不要", "必要", "賞味期限") 'チェックするキーワードのリスト
　 '念のため配列の上限をチェック
　 If NN > UBound(s1) + 1 Then Imax = UBound(s1) Else Imax = NN - 1
　 For II = 0 To Imax
　　　flg = flg Or Left(arg1, Len(s1(II))) = s1(II)
　 Next
　 tp1 = flg
End Function

こんな感じです。
orなので関係ないワードもチェックしても特に問題はなさそうな（出ないなら問題はない）気はしますが。
【42116】Re:条件数の変化
お礼  もとあし  - 06/9/1(金) 15:08 -
引用なし
パスワード
   ▼りん さん　こんにちは。

お返事遅くなってすみません。

>'判定する関数
>関数tp1 arg1:判定基準の文字列, NN:チェックするキーワードの数（上限）
>Function tp1(arg1 As String, NN As Integer) As Boolean
>　 Dim flg As Boolean, s1 As Variant, II As Integer, Imax As Integer
>　 s1 = Array("不要", "必要", "賞味期限") 'チェックするキーワードのリスト
>　 '念のため配列の上限をチェック
>　 If NN > UBound(s1) + 1 Then Imax = UBound(s1) Else Imax = NN - 1
>　 For II = 0 To Imax
>　　　flg = flg Or Left(arg1, Len(s1(II))) = s1(II)
>　 Next
>　 tp1 = flg
>End Function

↑のUBound、使ったことないのですが、ヘルプなどで見て
分かっていたつもりでしたが、実は分かっていないことに気づきました。
今、少し他の業務で忙しく、じっくり学習できないので、それが片付いたら
もう一度UBoundやLBoundとは何か？を調べて、改めてこのコードを自分なりに
理解したいと思います。
そしてまた分からなかったら、再度質問したいと思います。
なので、ちょっと時間が必要なので、取り急ぎお礼だけさせてください。
ありがとうございました。

>orなので関係ないワードもチェックしても特に問題はなさそうな（出ないなら問題はない）気はしますが。

もし、私にコードが組めなかったらそれでも最悪OKのようですが、
出る可能性もまったくない訳でもなく、万が一を考えると
分けた方がいいようなのです。

ありがとうございました。
【42264】Re:条件数の変化
質問  もとあし  - 06/9/5(火) 10:55 -
引用なし
パスワード
   りん さん　こんにちは。

少し時間が空いてしまいましたが、また少し教えてください！

>>'判定する関数
>>関数tp1 arg1:判定基準の文字列, NN:チェックするキーワードの数（上限）
>>Function tp1(arg1 As String, NN As Integer) As Boolean
>>　 Dim flg As Boolean, s1 As Variant, II As Integer, Imax As Integer
>>　 s1 = Array("不要", "必要", "賞味期限") 'チェックするキーワードのリスト
>>　 '念のため配列の上限をチェック
>>　 If NN > UBound(s1) + 1 Then Imax = UBound(s1) Else Imax = NN - 1
>>　 For II = 0 To Imax
>>　　　flg = flg Or Left(arg1, Len(s1(II))) = s1(II)
>>　 Next
>>　 tp1 = flg
>>End Function
>
>↑のUBound、使ったことないのですが、ヘルプなどで見て
>分かっていたつもりでしたが、実は分かっていないことに気づきました。
>もう一度UBoundやLBoundとは何か？を調べて、改めてこのコードを自分なりに
>理解したいと思います。

UBoundについては理解したと思います。
上記のコードも実際に動かして見たりして、大まかな理解したと思うのですが、
>>　　　flg = flg Or Left(arg1, Len(s1(II))) = s1(II)
のflg = flg が、何なのかよく分かりません。

また、コードは
>>　 s1 = Array("不要", "必要", "賞味期限")
のリストの例えば全部とか、2番目までで判定してね、
などと指定するのですよね？

もし、表1のKeywordが("不要", "必要", "賞味期限") とした場合の
表2のKeywordが("不要", "必要", "廃棄","新品") などと
一部が異なる場合、はどのように分岐したらいいのでしょうか。

教えていただけたらと思います。
よろしくお願いします。
【42271】Re:条件数の変化
回答  Kein  - 06/9/5(火) 11:56 -
引用なし
パスワード
   まず、表1と表2の配置が

表1 → B:L列、表2 → N:X列　を列範囲として、行数は各表においては同じだが、
1と2を比較すると違う かつ どちらも一定ではない。(開始行はいずれも7行目)
Ketwordの入力されているところは、L列とX列。

という条件のとき Workbooks("wb").Sheets("sheet1") の A:K列 1行目から、
表1,2の該当するデータを並べていく、という処理にするなら

Sub TestA()
　 Dim Sh As Worksheet
　 Dim LR1 As Long, LR2 As Long
　
　 Set Sh = Workbooks("wb.xls").Sheets("Sheet1")
　 LR1 = Range("L65536").End(xlUp).Row
　 LR2 = Range("X65536").End(xlUp).Row
　 Range("IV:IV").ClearContents
　 On Error Resume Next
　 With Range("IV7:IV" & LR1)
　　　.Formula = _
　　　"=IF(OR(L7=""不要"",L7=""必要"",L7=""賞味期限""),1,"""")"
　　　Intersect(.SpecialCells(3, 1).EntireRow, Range("B:L")) _
　　　.Copy Sh.Range("A65536").End(xlUp).Offset(1)
　　　.ClearContents
　 End With
　 With Range("IV7:IV" & LR2)
　　　.Formula = _
　　　"=IF(OR(X7=""不要"",X7=""必要"",X7=""廃棄"",X7=""新品""),1,"""")"
　　　Intersect(.SpecialCells(3, 1).EntireRow, Range("N:X")) _
　　　.Copy Sh.Range("A65536").End(xlUp).Offset(1)
　　　.ClearContents
　 End With
　 Set Sh = Nothing
End Sub
【42453】Re:条件数の変化
お礼  もとあし  - 06/9/12(火) 15:22 -
引用なし
パスワード
   ▼Kein さんこんにちは

回答えをありがとうございます。
お返事が大変遅くなり、すみません。
最近少々忙しくなりまして、VBAから少し離れてました。

作業列を作るということがいつも私の頭から抜けています。
回答を見せていただいて、そうかぁ。。。と感嘆です。

Keinさんの例とりんさんの例とを
いろいろ試して行きたいと思っています。

また時間があいてしまうかもしれませんが、
分からないことがでてきましたら質問させていただきますので、
教えてください。

ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6900 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free