Вставка значения во 2-ю ячейку на основе значения в 1-й ячейке

Question

Я пытаюсь написать сценарий, в котором, когда он считывает весь столбец, начиная с E2, и если ячейка в этом столбце имеет определенное значение (для этого примера, скажем, A, E, I, O или U) затем он вводит значение «Y» в ячейку F2, однако продолжает этот шаблон до тех пор, пока не закончатся заполненные ячейки в столбце E.

Я понимаю logi c of

Dim ColE As String

    For ColE = 2 To Rows.Count

    Next i

If E1 = "A" Or "E" Or "I" Or "O" Or "U" Then F2 = "Y"

, но как мне повторить это, скажем, полностью вниз по всему столбцу E, пока не закончатся заполненные ячейки в столбце E

Answer 1

Подходящим вариантом здесь является использование команды select case с if-l oop

for i = 2 to Cells(Rows.Count, 5).End(xlUp).Row '5 = Column E 
    Select Case Range("E"&i).value
    Case "A", "E", "I", "O", "U"
        Range("F"&i).value
    End Select
next

Использование Select Case позволяет вам также давать разные команды для других входов в столбце E, и это намного проще обработчик, чем условия if для ваших требований c.

Cells(Rows.Count, 5).End(xlUp).Row '5

Это вернет номер строки последней записи в пятом столбце (столбец E). Вы можете использовать его в for-l oop для итерации до самой последней строки.

Answer 2

Поиск по нескольким критериям

• Скопируйте код в стандартный модуль (например, Module1).
• Тщательно настройте значения в разделе констант.

Код

Option Explicit

Sub searchMultipleCriteria()
    ' Handle Errors
    Const Proc = "searchMultipleCriteria"
    On Error GoTo cleanError

    ' Define constants.
    Const SheetName As String = "Sheet1"
    Const FirstRow As Long = 2
    Const CriteriaCol As Variant = "E" ' 1 or "A"
    Dim CriteriaVals As Variant: CriteriaVals = Array("A", "E", "I", "O", "U")
    Const ResultCol As Variant = "F"   ' 1 or "A"
    Const ResultVal As String = "Y"
    Dim wb As Workbook: Set wb = ThisWorkbook

    ' Write values from Criteria Column Range to Criteria Array.
    Dim ws As Worksheet: Set ws = wb.Worksheets(SheetName)
    Dim rng As Range
    Set rng = ws.Columns(CriteriaCol).Find("*", , xlFormulas, , , xlPrevious)
    If rng Is Nothing Then GoTo EmptyColumn
    If rng.Row < FirstRow Then GoTo NoRange
    Set rng = ws.Range(ws.Cells(FirstRow, CriteriaCol), rng)
    Dim Criteria As Variant: Criteria = rng.Value

    ' Write values from Result Column Range to Result Array.
    Set rng = rng.Offset(, ws.Columns(ResultCol).Column - rng.Column)
    Dim Result As Variant: Result = rng.Value

    ' Modify values in Result Array.
    Dim i As Long, Curr As Variant
    For i = 1 To UBound(Criteria)
        ' Note: 'Match' is not case-sensitive i.e. A=a...
        Curr = Application.Match(Criteria(i, 1), CriteriaVals, 0)
        If Not IsError(Curr) Then
            Result(i, 1) = ResultVal
        Else ' Maybe you wanna do something here...
            'Result(i, 1) = "N"
        End If
    Next i

    ' Write values from Result Array to Result Range.
    rng.Value = Result

    ' Inform user.
    MsgBox "Data transferred.", vbInformation, "Success"

' Revert Settings (not utilized in this Sub)
CleanExit:

Exit Sub

' Not As Planned
EmptyColumn:
    MsgBox "Looking in an empty column to define a range with values!?", _
      vbExclamation, "'" & Proc & "': Empty Column"
    GoTo CleanExit
NoRange:
    MsgBox "Trying to define a range with an ending row lower than " _
      & "the starting row!?", _
      vbExclamation, "'" & Proc & "': No Range"
    GoTo CleanExit
cleanError:
    MsgBox "An unexpected error occurred in '" & Proc & "'!" & vbCr _
      & "Run-time error '" & Err.Number & "':" & vbCr & Err.Description, _
      vbCritical, "'" & Proc & "': Unexpected Error"
    On Error GoTo 0
    GoTo CleanExit
End Sub

Answer 3

Вот простой способ реализовать список OR:

Sub marine()
    Dim s1 As String, s2 As String
    s1 = "AEIOU"

    For i = 2 To 25
        If Range("E" & i).Value <> "" Then
            If InStr(s1, Range("E" & i).Value) > 0 Then
                Range("F" & i).Value = "Y"
            End If
        End If
    Next i
End Sub