宏可在行中查找特定文本並復制到同一行中的單元格

Question

我有一本工作簿，我想做的是在B和G之間的一行中找到“假日”一詞，並將“假日”一詞放在A列的同一行中的單元格中，我附加了在工作表中，我需要忽略包含“ Rest”的單元格，只需將“假期”放在包含“ Yes”的單元格中

Sub dural()
    Dim AB As Range, r As Range, K As Long
     Set AB = Range("B:G").Cells.SpecialCells(xlCellTypeConstants)
    K = 1
        For Each r In AB
        If InStr(1, r.Value, "holiday") > 0 Then
        r.Copy Cells(K, "A")
        K = K + 1
    End If
    Next
End Sub

我在網站上的其他位置找到了此代碼，但是它的執行方式是將第1行中的“假日”放在A列中，直到發現“假日”的次數為止

誰能幫我嗎？

Answer 1

您還可以創建一個For循環來執行此任務：

Sub Holiday()

lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastrow
        If Cells(i, 1).Value = "Yes" Then
            If Application.WorksheetFunction.CountIf("B" & i & ":G" & i, "holiday") > 0 Then
                    Cells(i, 1).Value = "holiday"
            End If
        End If
    Next i

End Sub

由於您在示例中還包括了顏色編碼，因此我添加了一行，該行也將單元格的顏色更改為綠色。

Answer 2

我不確定，但我相信您正在尋找這樣的東西：

Sub dural()

Dim AB As Range, r As Range
Set AB = Range("B:G").Cells.SpecialCells(xlCellTypeConstants)

For Each r In AB
    If InStr(1, LCase(r.Value), "holiday") > 0 And _
        LCase(Cells(r.Row, "A").Value) = "yes" Then
            r.Copy Destination:=Cells(r.Row, "A")
    End If
Next r

End Sub

Answer 3

假設H列為空：

[H2:H37] = "=IF(AND(A2=""Yes"",COUNTIF(B2:G2,""holiday"")),""holiday"",A2)"
[A2:A37] = [H2:H37].Value2
[H2:H37] = ""

Answer 4

您並不是完全缺乏解決方案，但是無論如何，這里都是可行的。 這使用查找

Sub x()

Dim rFind As Range, s As String

With Range("B2", Range("G" & Rows.Count).End(xlUp))
    Set rFind = .Find(What:="holiday", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not rFind Is Nothing Then
        s = rFind.Address
        Do
            If Cells(rFind.Row, 1).Value = "Yes" Then
                Cells(rFind.Row, 1).Value = "holiday"
            End If
            Set rFind = .FindNext(rFind)
        Loop While rFind.Address <> s
    End If
End With

End Sub

Answer 5

Sub holiday()

Dim cell As Range

 For Each c In Worksheets("Sheet1").Range("B:D").cells
        If c.Value = "holiday" Then
            Set curCell = Worksheets("Sheet1").cells(c.Row, 1)
                curCell.Value = "holiday"
        End If

Next

End Sub

根據需要更改參數...我建議使用特定范圍而不是全局范圍... B1：G10代替B：G以提高性能