Excel VBA - 列Bに値が含まれている場合は、列Aを値で更新します。列Bに値が含まれていない場合、マクロを実行しない

Question

私のシナリオでは、私は4つの列、列A~Dを持っています。列Bに何らかの値が含まれている場合、列Aの一致する行は所定の値を含むように更新されなければならない。同じマクロは、私は、コードは今それがその結果を達成している列C及びDに適用される：

Sub Update_Column_Based_On_Column_Value1() 
On Error Resume Next 
    Dim ws As Worksheet 
    Dim lRow As Long 

    Set ws = ThisWorkbook.Sheets("Sheet1") 

    With ws 
     lRow = .Range("B" & .Rows.Count).End(xlUp).Row 

     .Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).Formula = "=If(B1<>"""",""PREDETERMINED VALUE"","""")" 
     .Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value 
    End With 
End Sub 

列Bに値が含まれている場合、マクロは、列A中の対応するセルに「所定の値」を書き込みます

列に値がまったく含まれていない場合に問題が発生します。何が起こるかは、マクロがデータセット全体のほぼすべての空白セルに新しい値を書き込むことです。

ありがとうございました！私の質問がノービッシュであれば謝りますが、私はまだVBAにはとても新しいです。

Answer 1

この問題を回避するためにコメントセクションにIf WorksheetFunction.CountA(ws.Range("B:B")) = 1を使用することは良い試みですが、以下に説明するような例外があります。さまざまなシナリオ（特に空白範囲を使用）を使用して複数回テストし、毎回望ましい結果が得られているかどうかを確認します。

ただし、コードを簡略化しようとすると、いつかthe .SpecialCells(xlCellTypeBlanks) VBA function does not work as expected in Excelとなります。

また、On Error Resume Nextというステートメントは、実行可能な限り使用しないでください。しかし、必要があれば、On Error GoTo 0ステートメントを確実に挿入して、他のエラーをマスクしないようにしてください。

.SpecialCellsの代わりに、この問題を回避するためにFor Eachループを使用することができます。だからそれはどのように見えるかを見てみましょう：

Sub Update_Column_Based_On_Column_Value1() 
    Dim ws As Worksheet, lRow As Long, r As Range 
    Set ws = ThisWorkbook.Sheets("Sheet1") 
    With ws 
     lRow = .Range("B" & .Rows.Count).End(xlUp).Row 
     For Each r In .Range("A1:A" & lRow) 
      If IsEmpty(r) Then 
       r.Formula = "=If(B" & r.Row & "<>"""",""PREDETERMINED VALUE"","""")" 
       r = r.Value 
      End If 
     Next 
    End With 
End Sub 

Answer 2

ここでは誰も答えです！

Sub Update_Column_Based_On_Column_Value_1() 
    On Error Resume Next 
     Dim ws As Worksheet 
     Dim lRow As Long 

     Set ws = ThisWorkbook.Sheets("Sheet1") 

     If WorksheetFunction.CountA(ws.Range("B:B")) = 1 Then 

     Else 

      With ws 
       lRow = .Range("B" & .Rows.Count).End(xlUp).Row 
       .Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=If(LEN(RC2),""NEW TEXT HERE"", TEXT(,))" 
       .Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value 
      End With 
     End If 
    End Sub