Excel VBA重复创建

Question

目标：

1. 在 Sheet1 中搜索第 18 列中的关键字（关键字：大小写等）

2. 一旦找到关键字，偏移量(0,-11)

3. 在相应的单元格中输入给定值 C1008。

4. 并重复相同的操作，直到完成整列（大约 1500 行）

我无法执行第四步。 而且我需要多个关键字来搜索并执行相同的步骤。

程序：

Sub RCIM()                                    
    Dim ws As Worksheet
    Dim aCell As Range

    Range("A1").Select
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        Set aCell = .Columns(18).Find(What:="case", LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False)
        If Not aCell Is Nothing Then
            aCell.Offset(0, -10).Value = "C1008"
        Else
            MsgBox "Not Found"
         End If
    End With
End Sub

Answer 1

如果您只想重复您的代码，请使用这样的循环语句：

Sub RCIM()                                    
    Dim ws As Worksheet
    Dim aCell As Range
    DIM isTimetoExit As Boolean
    Dim currentRow As Long   'Counter of Rows
    Dim KeyWord as String

    Range("A1").Select
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws

        isTimetoExit = False
        currentRow = 1            'If you start from row 1
        KeyWord = "case"

        DO
            ' 
            Set aCell = .Columns(18).Find(What:=KeyWord, LookIn:=xlValues, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False)

            If Not aCell Is Nothing Then
                aCell.Offset(0, -10).Value = "C1008"
            Else
                MsgBox "Not Found"
            End If
            '

            ' Whit a condition go out of loop
            isTimetoExit = NOT (Trim(.Cells(currentRow, 1).Value & "") = "")
            If (isTimetoExit) THEN EXIT DO

            'Go for next row
            currentRow = currentRow + 1
            ' And set the keyword to your new value;
            KeyWord = "next case"  'But I don't know where are those KeyWords stroes !?
        LOOP
    End With
End Sub