根据第一个单元格中的值在第二个单元格中插入值

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 Case 还允许您为 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