2017-01-11 10 views
0

に時間ギャップおよびコピーのためのループ:私はこのような時代のリストを持っている別のワークシート

Start time End Time  Difference between times 
10:31:53 10:34:40  0.000115741 
10:34:50 10:35:21  0.000196759 
10:35:38 10:37:17  0.000138889 
10:37:29 10:37:52  0.000358796 
10:38:23 10:40:01  0.000324074 
10:40:29 10:40:59  4.62963E-05 
10:41:03 10:41:46  0.000173611 
10:42:01 10:42:33  0.000104167 

私は40分(0.02777778)よりも大きい違いを見つけるVBAを設定しようとすると、それ一度ています開始時刻と終了時刻をコピーします。 40分以上のギャップ時間があるかもしれませんので、それらをすべて(好ましくは右に縦にリストのように)コピーしたいと思います。基準を満たしている

Dim i As Range 
For Each i In Range("F14:F30000").SpecialCells(xlCellTypeVisible) 
    If i.Value > 0.02777778 Then 
     i.Select 
     Selection.Offset(, -2).Copy Destination:=Sheets("Time Gaps").Range("B3") 
     i.Select 
     Selection.Offset(1, -3).Copy Destination:=Sheets("Time Gaps").Range("D3") 
    End If 
Next i 

しかし、それだけをコピー最後のギャップ時間を:ここで

は、私がこれまで持っているものです。どのようにしてすべてを記録できるようにすることができますか?

ありがとうございます!

+0

(あなたのポストの下に編集リンクがあります)トピック開始を更新する代わりに、答えとして新しい質問を投稿してくださいあなたは書式を維持する必要がありますか?値が必要な場合は、2つの範囲をお互いに等しく設定します。 Range([destination range])。Value = Range([Copy from Range])。Value'。また、[.Select'/'.Activate'](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros)の使用を避けるのが最善です。 – BruceWayne

+0

@ BruceWayneあなたは時間のギャップ自体について話していますか?私は参照としてその列を使用していますが、違いを構成する開始時刻と終了時刻は、私が本当に後であることです。 – DLem

答えて

0

問題は、常にB3/D3に貼り付けることにあります。これを解決するには、宛先変数を作成する必要があります。これを行う1つの方法は、宛先セルを指す範囲変数を作成し、一致が見つかるたびに参照をシフトすることです。

Dim rDest as range 
Set rDest = Sheets("Time Gaps").Range("D3") 'init reference 

次に、コピー行を次のように置き換えます。

Selection.Offset(, -2).Copy Destination:=rDest 

rDest.offsetを使用して、宛先セルに相対的なシフトを行うことができます。

最後に、次の行を追加する場合は直前。

Set rDest = rDest.Offset(1,0) 'set range to next row 
+0

新しい式を示す答えを追加しました。私はあなたがこれで行くところが好きですが、編集した方法で私を助けてくれますか? – DLem

0

結果はセルB3/D3にコピーされ、最後の結果を除くすべての結果が上書きされます。これはかなりうまく機能している

Dim i As Range 
dim counter as Integer 
For Each i In Range("F14:F30000").SpecialCells(xlCellTypeVisible) 
    If i.Value > 0.02777778 Then 
     i.Select 
     Selection.Offset(, -2).Copy Destination:=Sheets("Time Gaps").Cells(counter + 3, 2) 
     i.Select 
     Selection.Offset(1, -3).Copy Destination:=Sheets("Time Gaps").Cells(counter + 3, 2) 
     counter = counter + 1 
    End If 
Next i 
0

最も簡単な方法は、おそらくデータがカバーされているどの行で決定カウンターだろう。開始時刻と終了時刻の両方を「タイムギャップ」シートにコピーしたかったので、rDest2を追加しました。 2番目のギャップ時間がどのようにオフセットに貼り付けられているかに関わらず、問題が発生しています。これは私の式である:私はに投稿しようとしています

Dim i As Range 
Dim rDest As Range 
Dim rDest2 As Range 
Set rDest = Sheets("Time Gaps").Range("B3") 
Set rDest2 = Sheets("Time Gaps").Range("D3") 
For Each i In Range("F14:F30000").SpecialCells(xlCellTypeVisible) 
    If i.Value > 0.02777778 Then 
     i.Select 
     Selection.Offset(, -2).Copy Destination:=rDest 
     i.Select 
     Selection.Offset(1, -3).Copy Destination:=rDest2 
     Set rDest = rDest.Offset(0, 4) 
     Set rDest2 = rDest.Offset(0, 4) 
    End If 
Next i 

の時間的ギャップシートは次のようになりヘッダを持っています

(Time Start) (Time Gap) (Time End) (Time Start) (Time Gap) (Time End)(Time Start) (Time Gap) (Time End) 
+1

Set rDest2 = rDest.Offset(0、4)をSet rDest2 = rDest2.Offset(0,4)に変更する必要がありました。 – DLem

0

あなたは4列でオフセットのようなあなたのヘッダがセットで繰り返されながら、ルックスあなたはおそらくオフセット(0,3)する必要があります。また、DLemのコメントを見てください。

PS:別の変数rDest2を宣言する必要はありません。

i.Offset(, -2).Copy Destination:=rDest 
    i.Offset(1, -3).Copy Destination:=rDest.offset(0,1) 'or (0,2) if the 2nd item has to be 2 columns to the right 

PS2:

関連する問題