Код должен сдвинуться на 2000 строк, чтобы увидеть, есть ли в какой-либо ячейке диапазона «Y», и нужно ли записать «Y» в первом столбце.

Question

Код должен сдвинуться на 2000 строк, чтобы увидеть, есть ли в какой-либо ячейке диапазона «Y», и нужно ли записать «Y» в первом столбце

Это код, который я сделал, который работает, но очень повторяется для 2000 строк:

Range("BD5").Select

Set rng = Range("BD5:CI5")

If Not rng Is Nothing Then
  For Each cell In rng.Cells
    If cell.Value = "Y" Then ActiveCell.FormulaR1C1 = "Y"
  Next cell
End If

'add loop to last cell 2000 times or 1250 times'

ActiveCell.Offset(1, 0).Range("A1").Select
Set rng = Range("BD6:CI6")

If Not rng Is Nothing Then
  For Each cell In rng.Cells
    If cell.Value = "Y" Then ActiveCell.FormulaR1C1 = "Y"
  Next cell
End If

ActiveCell.Offset(1, 0).Range("A1").Select
Set rng = Range("BD7:CI7")

If Not rng Is Nothing Then
  For Each cell In rng.Cells
    If cell.Value = "Y" Then ActiveCell.FormulaR1C1 = "Y"
  Next cell
End If

ActiveCell.Offset(1, 0).Range("A1").Select
Set rng = Range("BD8:CI8")

If Not rng Is Nothing Then
  For Each cell In rng.Cells
    If cell.Value = "Y" Then ActiveCell.FormulaR1C1 = "Y"
  Next cell
End If

ActiveCell.Offset(1, 0).Range("A1").Select
Set rng = Range("BD9:CI9")

If Not rng Is Nothing Then
  For Each cell In rng.Cells
    If cell.Value = "Y" Then ActiveCell.FormulaR1C1 = "Y"
  Next cell
...

Это код, который я пытался сделать с циклом, но он не работал, потому что я не могу понять, как зацикливать диапазон, чтобы просматривать только одну строку за раз, а затем переходить к следующей

Range("BC5").Select

Dim rng As Range
Dim cell As Range

Set rng = Range("BD5:CI5")

If Not rng Is Nothing Then
  For Each cell In rng.Cells
    If cell.Value = "Y" Then ActiveCell.FormulaR1C1 = "Y"
  Next cell
End If

For I = 1 To 100
  ActiveCell.Offset(1, 0).Range("A1").Select
  Set Range = rng.Offset(1, 0) 'need to edit this so that the range will go through all rows in the document'

  If Not rng Is Nothing Then
    For Each cell In rng.Cells
      If cell.Value = "Y" Then ActiveCell.FormulaR1C1 = "Y"
    Next cell
  End If
Next I

Answer 1

Работает ли это для вас:

Sub test()
Dim myArray As Variant, i As Long, myRange As Range
With Sheets("Sheet2") 'name of your sheet
Set myRange = .Range("BD5:CI2000")
    With Application
    myArray = myRange
    For i = LBound(myArray) To UBound(myArray)
    If InStr(1, Join(.Transpose(.Transpose(.Index(myArray, i, 0)))), "Y", vbTextCompare) > 0 Then myArray(i, 1) = "Y"
    Next i
    myRange.Resize(, 1) = .Index(myArray, 0, 1)
End With
End With