Excel VBA質問箱 IV

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

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


71913 / 76732 ←次へ | 前へ→

【9310】Re:手に負えない
回答  りん E-MAIL  - 03/11/27(木) 21:11 -

引用なし
パスワード
   他にどんな定義があるのかわからないので分岐の一例です。

分岐の部分だけ修正したものです。mainは前回のままなので載せていません。
Sub Check8and9(wb As Workbook)
  Dim RR&, Rmax&, Rpos&, II%, Rec$
  Dim ws(1 To 2) As Worksheet
  '
  Set ws(1) = ThisWorkbook.Worksheets("Sheet4")
  ws(1).Cells.Clear 'Sheet4を初期化
  Rpos& = 0 '書き出すときは上詰めで
  '開始
  On Error Resume Next
  '『Sheet8&9』を検索ということ?
  Set ws(2) = wb.Worksheets("Sheet8&9")
  On Error GoTo 0
  '『Sheet8&9』というシートが無かったらその後の処理は無し
  If Not ws(2) Is Nothing Then
   With ws(2).UsedRange
     Rmax& = .Cells(.Count).Row
   End With
   For RR& = 8 To Rmax&
     'AFが0以外の時
     If ws(2).Cells(RR&, 32).Value <> 0 Then
      With ws(2)
        Rec$ = .Cells(RR&, 11).Value & .Cells(RR&, 13).Value & _
           .Cells(RR&, 14).Value & .Cells(RR&, 18).Value
      End With
      '
      If Rec$ = "" Or Rec$ = "1A11" Then
        '空白セルまたは条件に合致した場合はなにもしない
      Else
        Rpos& = Rpos& + 1
        With ws(1)
         For II% = 1 To 3
           .Cells(Rpos&, II%).Value = _
            ws(2).Cells(RR&, II% + 3).Value
         Next
         With .Cells(Rpos&, 4)
           Select Case Rec$
            Case "1A10"
              .Value = "不具合A"
              .EntireRow.Font.ColorIndex = 3
            Case "1B10"
              'たとえばM列の値がBの場合の分岐例
              .Value = "不具合B"
              .EntireRow.Font.ColorIndex = 3
            Case Else
              '定義漏れかつO列に×が入っているものの抽出例
              If ws(2).Cells(RR&, 15).Value = "×" Then
               .Value = "定義漏れ×"
               .EntireRow.Font.ColorIndex = 44
              Else
               .Value = "定義漏れ"
               .EntireRow.Font.ColorIndex = 44
              End If
           End If
         End With
         'おまけ
         .Cells(Rpos&, 5).Value = RR& '元の行番号
        End With
      End If
     End If
   Next
   Set ws(2) = Nothing
  End If
  '結果表示
  ThisWorkbook.Activate
  ws(1).Activate
  Erase ws
End Sub
こんな感じです。

条件を全て満たすかどうかについて、連結した文字列にして判定する方法以外ならば、And 演算子を使って論理積を求めればいいです。
Sub test()
  Dim tf As Boolean, I As Integer
  For I = 8 To 10
   tf = (Cells(I, 11).Value = 1) And _
      (Cells(I, 13).Value = "A") And _
      (Cells(I, 14).Value = 1) And _
      (Cells(I, 18).Value = 1)
   If tf Then
     MsgBox "一致", vbInformation, I & "行目"
   Else
     MsgBox "不一致", vbInformation, I & "行目"
   End If
  Next
End Sub

直接If文でも同じこと
Sub test()
  Dim I As Integer
  For I = 8 To 10
   '
   If (Cells(I, 11).Value = 1) And (Cells(I, 13).Value = "A") And _
     (Cells(I, 14).Value = 1) And (Cells(I, 18).Value = 1) Then
     MsgBox "一致", vbInformation, I & "行目"
   Else
     MsgBox "不一致", vbInformation, I & "行目"
   End If
  Next
End Sub

0 hits

【9213】手に負えない ブーちゃん 03/11/24(月) 2:48 質問
【9216】Re:手に負えない りん 03/11/24(月) 10:03 回答
【9281】Re:手に負えない ブーちゃん 03/11/26(水) 17:13 質問
【9310】Re:手に負えない りん 03/11/27(木) 21:11 回答
【9314】Re:手に負えない ブーちゃん 03/11/28(金) 11:00 質問
【9341】リストボックスで選択したファイルの内容チ... りん 03/11/30(日) 10:19 回答
【9352】Re:リストボックスで選択したファイルの内... ブーちゃん 03/11/30(日) 16:31 質問
【9361】Re:リストボックスで選択したファイルの内... りん 03/11/30(日) 18:17 発言
【9377】Re:リストボックスで選択したファイルの内... ブーちゃん 03/12/1(月) 15:19 回答
【9400】Re:リストボックスで選択したファイルの内... りん 03/12/2(火) 23:22 回答
【9843】Re:リストボックスで選択したファイルの内... ブーちゃん 03/12/18(木) 14:16 質問
【9870】Re:リストボックスで選択したファイルの内... ブーちゃん 03/12/19(金) 15:38 お礼

71913 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free