行内の特定のテキストを見つけて同じ行のセルにコピーするマクロ

Question

ブックを持っていて、私がやっていることは、BとGの間の行に "holiday"という単語を見つけ、 "holiday"という単語を列Aの同じ行にあるセル、シートの写真を添付し​​ました。「残り」を含むセルを無視し、「はい」を含むセルに「休日」を入れる必要があります。

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

あなたはまた、このタスクを実行するループについてはを作成することができますあなたの例では色分けしていますが、セルの色も緑色に変更する行が追加されています。その列のHを仮定

Answer 2

私はわからないが、私はあなたがこのような何かを探していると信じて：あなたので

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 

：

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

は空です：

[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パフォーマンス上の目的のために