Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Microsoft 365)
If- Then 複数条件について
投稿日時: 22/03/25 18:06:16
投稿者: Yukstar

 セルAが空欄の場合を除き、且つセルBとセルCがどちらも"X"の場合を除いたデータを抽出したいです。
  (セルAが空欄の場合を除き、セルBもしくはセルCどちらか一方が"X"の場合は抽出対象。)
   
 
 目的のデータは、下記コードで一応取得できています。
 
 ですが、同じようなIF条件文がずらずらと並んでおり読みずらいのと、条件が増えた場合も想定して別のやり方はないものかと考えていましたが、思い浮かばず。
 
 基本的な質問かと思いますが、皆さまのお知恵を拝借したく、もっとスマートなやり方をご存じの方、ご教示いただければ幸いです。宜しくお願いします。
 
   
        Dim i As Integer
        Dim r As Long
 
             
                r = 1
                For i = 5 To lastrow
                 
                        If Sheet1.Cells(i, "A").Value <> "" And Sheet1.Cells(i, "B").Value = "X" And Sheet1.Cells(i, "C").Value <> "X" Or _
                           Sheet1.Cells(i, "A").Value <> "" And Sheet1.Cells(i, "B").Value <> "X" And Sheet1.Cells(i, "C").Value = "X" Or _
                           Sheet1.Cells(i, "A").Value <> "" And Sheet1.Cells(i, "B").Value <> "X" And Sheet1.Cells(i, "C").Value <> "X" Then
 
                            Sheet1.Rows(i).Copy
                            ws.Range("A4").Offset(r, 0).PasteSpecial Paste:=xlPasteValues
                            Application.CutCopyMode = False
                 
                            r = r + 1
                 
                        End If
                     
       
                Next i

回答
投稿日時: 22/03/25 20:29:47
投稿者: simple

こういうことでしょうか?
 

Sub test()
   Dim i As Long
   Dim r As Long

   r = 1
   For i = 5 To lastrow
       If Sheet1.Cells(i, "A").Value <> "" Then
           If Sheet1.Cells(i, "B").Value <> "X" Or Sheet1.Cells(i, "C").Value <> "X" Then
               Sheet1.Rows(i).Copy
               ws.Range("A4").Offset(r, 0).PasteSpecial Paste:=xlPasteValues
               Application.CutCopyMode = False
               r = r + 1
           End If
       End If
   Next i
End Sub

回答
投稿日時: 22/03/25 20:31:18
投稿者: simple

もちろん、lastRow とか wsは別途手当してください。

回答
投稿日時: 22/03/25 21:05:58
投稿者: WinArrow
投稿者のウェブサイトに移動

コード差替えです。

引用:

                        If Sheet1.Cells(i, "A").Value <> "" And Sheet1.Cells(i, "B").Value = "X" And Sheet1.Cells(i, "C").Value <> "X" Or _
                           Sheet1.Cells(i, "A").Value <> "" And Sheet1.Cells(i, "B").Value <> "X" And Sheet1.Cells(i, "C").Value = "X" Or _
                           Sheet1.Cells(i, "A").Value <> "" And Sheet1.Cells(i, "B").Value <> "X" And Sheet1.Cells(i, "C").Value <> "X" Then
  
                            Sheet1.Rows(i).Copy
                            ws.Range("A4").Offset(r, 0).PasteSpecial Paste:=xlPasteValues
                            Application.CutCopyMode = False
                            r = r + 1
                  
                        End If
   


 
    With Sheets("Sheet1")
        If .Cells(i, "A").Value <> "" Then
            If .Cells(i, "B").Value = "X" Or .Cells(i, "C").Value = "X" Then
                ws.Range("A4").Offset(r, 0).EntireRow.Value = .Rows(i).Value
                r = r + 1
            End If
       End If
    End With

で、よいと思います。
 

投稿日時: 22/03/26 02:21:34
投稿者: Yukstar

  こんなに早く教えていただきありがとうございます!!
 大変参考になりました!