Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1762 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【72092】複数セルからパターンを調べたい けい 12/5/28(月) 19:23 質問[未読]
【72093】Re:複数セルからパターンを調べたい kanabun 12/5/29(火) 9:58 発言[未読]
【72094】Re:複数セルからパターンを調べたい kanabun 12/5/29(火) 10:00 発言[未読]
【72095】Re:複数セルからパターンを調べたい UO3 12/5/29(火) 10:00 発言[未読]
【72096】Re:複数セルからパターンを調べたい UO3 12/5/29(火) 10:55 発言[未読]
【72099】Re:複数セルからパターンを調べたい ドカ 12/5/29(火) 16:28 発言[未読]
【72100】Re:複数セルからパターンを調べたい ドカ 12/5/29(火) 16:56 回答[未読]
【72102】Re:複数セルからパターンを調べたい けい 12/5/29(火) 17:39 お礼[未読]
【72092】複数セルからパターンを調べたい
質問  けい E-MAIL  - 12/5/28(月) 19:23 -
引用なし
パスワード
   いつも助けていただいてますが今日もよろしくお願いします。

ある一覧表があり、B列が●であるデータを対象とし、S列を基準にS〜Y列に日付が入ってる場合、パターン1〜４のどれかに当てはまるかをAR列に結果を入力したいのですがうまくいきません。
パターン1＝S,T,Yに日付がある場合
パターン2＝S,T,Uに日付がある場合
パターン3＝S,Tに日付がある場合
パターン1＝S,T,W,Xに日付がある場合

Sub 日付チェック()
　　Dim mRow As Long
　　Dim p As Long
　　Dim c As Range　

　　Application.ScreenUpdating = False
　
　　With Sheets("★★★")
　　　　mRow = WorksheetFunction.Max(.Range("B" & .Rows.Count).End(xlUp).Row)
　　　　　
　　　　For Each c In .Range("S4:S" & mRow)

　　　　　 If c.Offset(0, -17) = "●" And c.Value >= 1 And c.Offset(0, 1).Value >= 1 And c.Offset(0, 6).Value >= 1 Then
　　　　　　　　
　　　　　　　 c.Offset(0, 25).Value = 1

　　　　　 ElseIf c.Offset(0, -17) = "●" And c.Value >= 1 And c.Offset(0, 1).Value >= 1 And c.Offset(0, 2).Value >= 1 Then
　　　　　　　　　　　　　　　
　　　　　　　 c.Offset(0, 25).Value = 2
　　　　　　　　
　　　　　 ElseIf c.Offset(0, -17) = "●" And c.Value >= 1 And c.Offset(0, 1).Value >= 1 Then
　　　　　　　　　　　　　　　
　　　　　　　 c.Offset(0, 25).Value = 3
　　　　　　　
　　　　　 ElseIf c.Offset(0, -17) = "●" And c.Value >= 1 And c.Offset(0, 1).Value >= 1 And c.Offset(0, 4).Value >= 1 And c.Offset(0, 5).Value >= 1 Then　　　　　　　　　　　　　　
　　　　　　　 c.Offset(0, 25).Value = 4
　　　　　 End If
　　　　 Next　　　　
　　 End With
　　　
　　Application.ScreenUpdating = True

End Sub

どうしたらうまく判別させて結果を出せるのでしょうか。
【72093】Re:複数セルからパターンを調べたい
発言  kanabun  - 12/5/29(火) 9:58 -
引用なし
パスワード
   ▼けい さん：
>ある一覧表があり、B列が●であるデータを対象とし、
>パターン1＝S,T,Yに日付がある場合
>パターン2＝S,T,Uに日付がある場合
>パターン3＝S,Tに日付がある場合
>パターン1＝S,T,W,Xに日付がある場合

一案ですが、AutoFilterを使ってはどうでしょう？
3行目が表の列見出し行で、正味データは 4行目からの表があるとします。
最初に、「B列が●で」 かつ 「S,T列が日付である」行を抽出します。
↑の条件で抽出された行に 「パターン3」を記入します。それ以外の
パターンも最低↑この条件を満たしていないといけないので、とりあえず
「3」を記入しておきます。この3列のフィルタはそのままで、
のこりのパターンについて Y列も日付であれば 1を、
U列も日付であれば、2を
というように、フィルタをかけて抽出された行にパターンを記入します。
（条件をみたすパターンが複数ある行は、最後の条件パターンが記入されます）

Sub Try_日付チェック()
　　Dim rr As Range
　　Dim r As Range
　　
　　With Worksheets("★★★")
　　　　Set rr = .Range("Y3", .Cells(.Rows.Count, "B"). _
　　　　　　　　　　　　　　　　　End(xlUp).Offset(, -1))
　　　　.AutoFilterMode = False
　　End With
　　Set r = Intersect(rr, rr.Offset(1)) 'フィルタ範囲から見出しを除外
　　r.Columns("AR").ClearContents
　　
　　'B列が●である行
　　rr.AutoFilter 2, "●"
　　'S,T列が日付けである行
　　rr.AutoFilter 19, ">=40000"
　　rr.AutoFilter 20, ">=40000"
　　
　　If r.Columns(1).SpecialCells(xlVisible).Count > 0 Then
　　　　r.Columns("AR").Value = 3　　'ST列に日付
　　　　rr.AutoFilter 25, ">=40000"　'Y列
　　　　If r.Columns(1).SpecialCells(xlVisible).Count > 0 Then
　　　　　　r.Columns("AR").Value = 1 'STY列に日付
　　　　　　MsgBox "ok?"
　　　　End If
　　　　rr.AutoFilter 25
　　　　rr.AutoFilter 21, ">=40000"　'U列
　　　　If r.Columns(1).SpecialCells(xlVisible).Count > 0 Then
　　　　　　r.Columns("AR").Value = 2 'STU列に日付
　　　　　　MsgBox "ok?"
　　　　End If
　　　　rr.AutoFilter 21
　　　　
　　　　rr.AutoFilter 23, ">=40000"　'W列
　　　　rr.AutoFilter 24, ">=40000"　'X列
　　　　If r.Columns(1).SpecialCells(xlVisible).Count > 0 Then
　　　　　　r.Columns("AR").Value = 4 'STWX列に日付
　　　　　　MsgBox "ok?"
　　　　End If
　　End If
　　
　　rr.Worksheet.AutoFilterMode = False
End Sub
【72094】Re:複数セルからパターンを調べたい
発言  kanabun  - 12/5/29(火) 10:00 -
引用なし
パスワード
   ↑途中の MsgBox "ok?"
は、確認のためですので、テストがおわったらコメント(') にしておいて
ください。
【72095】Re:複数セルからパターンを調べたい
発言  UO3  - 12/5/29(火) 10:00 -
引用なし
パスワード
   ▼けい さん：

おはようございます

Ｂ列が　●　のものということですから、セルは　Ｓ列ではなく　Ｂ列を抽出するほうが
コードがわかりやすくなると思いますし、OffSet　で、あまりに大きな（10以上）の数を
指定するのは、指を折って勘定しなければいかなくなって、コードの可読性がおちてしまうと
思いますが、それはさておき。

アップされたパターン、たとえば　パターン 1　は　S,T,Y に日付がありますから
パターン 3 S,T に日付があるという条件にも合致しますよね。

ですから、・・・に日付がある　という条件は、・・・に日付があって、それ以外には
日付が無い　ということなんでしょうか？
ということであれば、【それ以外】　という領域を限定する必要がありますが
チェック対象の領域は S,T,U,W,X 、つまり S〜X 列の中の V 列を除いた領域ということですか？

それとも、パターンの優先順位として、1->2->3->4 ということでしょうか？
でも、それだと最後のパターン（ 1 と記載されていますが、きっと　4 ?) は、その前の
パターン 3 になってしまいますので、そうではないのでしょうね？
【72096】Re:複数セルからパターンを調べたい
発言  UO3  - 12/5/29(火) 10:55 -
引用なし
パスワード
   アップ後、なんらかの（たとえばチェックする行をＢ列以外にした場合）変更時の
対応を、よりすうー図にするため１行変更して再度アップします。

▼けい さん：

こんにちは

セルの値が日付かどうかということは悩ましいものがありますね。
ですのでアップされたコードでは 数値の 1 以上かどうかを判定、
あるいはkanabunさんのコードでは、より現実的に 40000 以上かどうかを
判定しておられますね。

たとえば IsDate という関数があります。
セルに 2012/5/29 と入っていたとして、IsDate は　True になります。
ところが、このセルの表示書式を　標準　にしますと　41058 という
シリアル値に変換されますけど、これを IsDate で判定しますと False になります。

で、日付かどうかという条件を、もう少し限定して、
【セルの上で日付として表示されているかどうか】ということにしますと、
以下のようなことでもいいかもしれません。

パターンは　1->2->3->4 の優先順位にしています。なので、申し上げたように
パターン 4 はありえないのですけど。

Sub 日付チェック2()
　　Dim c As Range
　　Dim dS As Variant
　　Dim dT As Variant
　　Dim dU As Variant
　　Dim dW As Variant
　　Dim dX As Variant
　　Dim dY As Variant
　　Dim ans As Variant
　　Dim v() As Variant
　　Dim k As Long
　　
　　With Sheets("★★★")
　　　　With .Range("B4", .Range("B" & .Rows.Count).End(xlUp))
　　　　　　ReDim v(1 To .Rows.Count, 1 To 1)
　　　　　　For Each c In .Cells
　　　　　　　　If c.Value = "●" Then
　　　　　　　　　　With c.EntireRow
　　　　　　　　　　　　dS = .Range("S1").Value
　　　　　　　　　　　　dT = .Range("T1").Value
　　　　　　　　　　　　dU = .Range("U1").Value
　　　　　　　　　　　　dW = .Range("W1").Value
　　　　　　　　　　　　dX = .Range("X1").Value
　　　　　　　　　　　　dY = .Range("Y1").Value
　　　　　　　　　　　　ans = ""
　　　　　　　　　　　　If IsDate(dS) And IsDate(dT) And IsDate(dY) Then
　　　　　　　　　　　　　　ans = 1
　　　　　　　　　　　　ElseIf IsDate(dS) And IsDate(dT) And IsDate(dU) Then
　　　　　　　　　　　　　　ans = 2
　　　　　　　　　　　　ElseIf IsDate(dS) And IsDate(dT) Then
　　　　　　　　　　　　　　ans = 3
　　　　　　　　　　　　ElseIf IsDate(dS) And IsDate(dT) And IsDate(dW) And IsDate(dX) Then
　　　　　　　　　　　　　　ans = 4
　　　　　　　　　　　　Else
　　　　　　　　　　　　　　ans = ""
　　　　　　　　　　　　End If
　　　　　　　　　　　　
　　　　　　　　　　　　k = k + 1
　　　　　　　　　　　　v(k, 1) = ans
　　　　　　　　　　End With
　　　　　　　　
　　　　　　　　End If
　　　　　　Next
　　　　　　.Offset(, Columns("AR").Column - .Column).Value = v
　　　　End With
　　End With
　　
　　MsgBox "判定して転記しました"
　　
End Sub
【72099】Re:複数セルからパターンを調べたい
発言  ドカ  - 12/5/29(火) 16:28 -
引用なし
パスワード
   ▼けい さん　こんにちは

私がやったところ、けいさんのコードをコピペしたままで、
ちゃんと動きましたよ。
一応報告です。
【72100】Re:複数セルからパターンを調べたい
回答  ドカ  - 12/5/29(火) 16:56 -
引用なし
パスワード
   ▼ドカ さん　こんにちは

ちょっと勘違いしてました。
確かに期待通りの動きはしないですね。

たとえば、条件３の判別を以下にすると、うまくいきましたよ。
まだ、不具合が出るようなら、同様の見直しをすれば、良いかと思いますよ。


ElseIf c.Offset(0, -17) = "●" And c.Value >= 1 And c.Offset(0, 1).Value >= 1 And c.Offset(0, 4).Value < 1 Then
　　　　　　　
　　　　　　　 c.Offset(0, 25).Value = 3
【72102】Re:複数セルからパターンを調べたい
お礼  けい E-MAIL  - 12/5/29(火) 17:39 -
引用なし
パスワード
   ▼ドカ さん：
ご回答をありがとうございます。
条件を細かくきちんと書けば結果が出るみたいですね。
ありがとうございました。


>▼ドカ さん　こんにちは
>
>ちょっと勘違いしてました。
>確かに期待通りの動きはしないですね。
>
>たとえば、条件３の判別を以下にすると、うまくいきましたよ。
>まだ、不具合が出るようなら、同様の見直しをすれば、良いかと思いますよ。
>
>
>ElseIf c.Offset(0, -17) = "●" And c.Value >= 1 And c.Offset(0, 1).Value >= 1 And c.Offset(0, 4).Value < 1 Then
>　　　　　　　
>　　　　　　　 c.Offset(0, 25).Value = 3
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1762 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free