2017-01-25 8 views
1

find/do関数を使用して、範囲J28:J115内の単語Spikeを検索したいと考えています。見つかったら、2つの値が取得され、別のワークシートに貼り付けられます。私はそれが単語を探し、値を置いてから、すべての値が置かれるまで単語をもう一度探します。Find/Do Loop - Excel 2010

ここまでは私のコードです。

' Find Spike Sample Name, paste in QAQC file' 

    Windows("a").Activate 
    Range("J28:J115").Select 
    Selection.Find(What:="spike", After:=ActiveCell, LookIn:=xlFormulas, _ 
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False).Activate 
    ActiveCell.Offset(0, -8).Select 
    Selection.Copy 
    Windows("b").Activate 
    Sheets("Spike").Select 
    Range("B" & Rows.Count).End(xlUp).Offset(1).Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 

'Copy Sample Value, paste in QAQC file' 
    Windows("Macro 20170113 NH3 BP Jan13 Stan Jan9 with smp blk JZ.xlsx").Activate 
    Range("J28:J115").Select 
    Selection.Find(What:="spike", After:=ActiveCell, LookIn:=xlFormulas, _ 
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False).Activate 
    ActiveCell.Offset(0, 1).Select 
    Selection.Copy 
    Windows("Macro Ammonia QA-QC Chart 20161104.xlsx").Activate 
    Range("C" & Rows.Count).End(xlUp).Offset(1).Select 
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Selection.NumberFormat = "0.0" 
    ActiveCell = ActiveCell * 100 

答えて

1

以下は、コードの最初の部分のループです。私はあなたが次にしようとしていることを知らない。指定された場所にソースシートの名前を設定することを忘れないでください。

Dim r As Range, first As Range, x As Range 
Set r = Sheets("source").Range("J28:J115") ' <-- set the name to your source sheet 
Set first = r.Find("spike", r(1, 1), xlValues, xlWhole, xlByRows, xlNext, False, False) 
If Not first Is Nothing Then 
    Set x = first 
    Do 
     Sheets("Spike").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = x.offset(, -8).Value 

     Set x = r.FindNext(x) ' , xlValues, xlWhole, xlByRows, xlNext) 
    Loop Until x.Address = first.Address 
End If