根據第一個單元格中的值在第二個單元格中插入值

Question

我正在嘗試編寫一個腳本，當它讀取以 E2 開頭的整個列時，如果該列中的單元格具有特定值（對於此示例，假設為 A、E、I、O 或 U）然后它進入單元格 F2 中的“Y”值，但是它會繼續這種模式，直到用完 E 列中的填充單元格。

我理解的邏輯

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

這是實現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

Answer 2

此處合適的選項是使用帶有 if 循環的 select case 命令

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 案例還允許您為 E 列中的其他輸入提供不同的命令，並且比針對您的特定要求的 if 條件更容易處理。

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

這將返回第五列（E 列）中最后一個條目的行號。 您可以在 for 循環中使用它來迭代直到最后一行。

Answer 3

搜索多個條件

• 將代碼復制到標准模塊（例如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