Excel - VBA 代码检查列 A（人名）与列 F(6) 到 K(11)，如果有包含“是”，则在空白行中添加“是”

Question

@FaneDuru kindly created the code below:

Sub fillYes()
  Dim sh As Worksheet, lastR As Long, arr, arrFin, i As Long, dict As Object
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  
  arr = sh.Range("A2:I" & lastR).Value2 'place the range in an array, for faster iteration
  'place the names having yes/yes in a dictionary:
  Set dict = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(arr)
        If arr(i, 8) = "yes" And arr(i, 9) = "yes" Then
            dict(arr(i, 1)) = 1
        End If
  Next i
  'place the columns to be adapted in an array:
  arrFin = sh.Range("H2:I" & lastR).Value2
  For i = 1 To UBound(arr)
        If dict.Exists(arr(i, 1)) Then arrFin(i, 1) = "yes": arrFin(i, 2) = "yes"
  Next i
  'drop the final array content at once:
  sh.Range("H2").Resize(UBound(arrFin), 2).value = arrFin
End Sub

Which would check Columns H and I. I'm just looking to amend this slightly so it also applies to Columns 6,7,8,9,10,11 (F to K). NOTE - Each column should be treated separately, so for example, if Column F contained a "Yes", that doesn't then automatically mean that all the columns for that person should contain a "Yes"

Any help would be greatly appreciated.

Answer 1

Please, use the next adapted answer. To avoid an imbricated range of many If - End If statements, I created boolYes variable which will become True of the first "yes" occurrence in the mentioned columns. The code also is able to deal with "Yes" or "YES" instead of only "yes":

Sub fillYes_Extended()
  Dim sh As Worksheet, lastR As Long, arr, arrFin, i As Long, dict As Object
  Dim j As Long, boolYes As Boolean
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  
  arr = sh.Range("A2:K" & lastR).Value2 'place the range in an array, for faster iteration
  
  'place the names having yes/yes in the required columns, in a dictionary:
  Set dict = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(arr)
        For j = 6 To 11
            If LCase(arr(i, j)) = "yes" Then boolYes = True: Exit For
        Next j
        If boolYes Then
            dict(arr(i, 1)) = 1: boolYes = False 'add the dictionary key and reinitialize boolYes variable
        End If
  Next i
  'place the columns to be adapted in an array:
  arrFin = sh.Range("F2:K" & lastR).Value2
  For i = 1 To UBound(arr)
        If dict.Exists(arr(i, 1)) Then
            For j = 1 To 6
                arrFin(i, j) = "yes"
            Next j
        End If
  Next i

  'drop the final array content at once:
  sh.Range("F2").Resize(UBound(arrFin), UBound(arrFin, 2)).Value = arrFin
End Sub

Please, test it and send some feedback.