• ベストアンサー

Excel VB 任意のセルから、最終行までの数式のコピー

任意のセルに、計算式を入力しております。  A   B   C 1 個数 金額  基準単価 2 5  15000  3000 3 123 25780          4 ・ ・ 600 C2には、B2/A2という計算式が入っております。 この計算式を、C600(浮動)までコピーしたいのですが、 どうしてもうまくいきません。。 Sub 基準単価() Dim i As Integer Application.ScreenUpdating = False  '1行目で検索 For i = Range("IV1").End(xlToLeft).Column To 1 Step -1   If InStr(Cells(1, i).Value, "基準単価") > 0 Then    Cells(2, i).FormulaR1C1 = B2/A2    Cells(2, i)Selection.AutoFill Destination:=    Range("Cells(2, i).End(xlDown)).Type:=xlFillDefault End If  Next i  Application.ScreenUpdating = False End Sub どうぞよろしくお願いします!!  

質問者が選んだベストアンサー

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんにちは。 >Cells(2, i).Formula = "=B2/A2" >のところを、 >Cells(2, i).Formula ="=Cells(2, i - 1) / Cells(2, i - 2)" >としました。 ワークシートにはワークシートの表現の仕方がありますから、VBAの表現方法ではうまくいきません。 "=B2/A2" これは、絶対参照になっていませんから、そのままでよいのです。 この意味は、 VBAでは、 Cells(2, i - 1) / Cells(2, i - 2) と同じことです。つまり、R1C1 方式でいうと、 "=RC[-1] /RC[-2]" このように書き表します。分かりやすいので、私は、こちらを使っています。 私なりの方法で考えてみました。オートフィル・メソッドは、デフォルト方式の場合などは、VBAではあまり使われません。 Sub 基準単価r() Dim i As Integer Application.ScreenUpdating = False  '1行目で検索 For i = Range("IV1").End(xlToLeft).Column To 3 Step -1   If InStr(Cells(1, i).Value, "基準単価") > 0 Then   '基準単価の列で範囲を取るよりは、個数や金額のところで範囲を取ったほうがよいと思います。ただし、End(xlDown)は、多少問題は残っています。    Range(Cells(2, i), Cells(2, i - 2).End(xlDown).Offset(, 2)).FormulaR1C1 = _     "=RC[-1]/RC[-2]"  '相対参照式を使います   End If  Next i  Application.ScreenUpdating = False End Sub もし、下に何も入れていない状態だったら、 Range(Cells(2, i), Cells(65536, i - 2).End(xlUp).Offset(, 2)).FormulaR1C1 = としたほうがよいと思います。それは、1行目だけか、2行目だけにしか入っていない場合は、一番、下まで、行ってしまいます。 また、Step -1 と、右から数式を入れているようですが、今回の場合、列の挿入がなければ、あまり関係がないようです。

acochaco
質問者

お礼

ありがとうございました!出来ました。 End(xlDown)よりも、End(xlUp)のほうがよいと、確かに 言われました。 いつも教えていただいてどうもありがとうございます。

その他の回答 (2)

  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.3

#1のmerlionXXです。 Wendy02さんがお書きのとおりですが。 Cells(2, i).Formula = "=B2/A2" を x = "=" & Cells(2, i - 1).Address(0, 0) & "/" & Cells(2, i - 2).Address(0, 0) Cells(2, i).Formula = x でも可能です。

acochaco
質問者

お礼

セルの指定が難しくて、進まない箇所が多いのが 現状です・・。 上記のような記述をするんですね! ありがとうございました! 勉強になりました!!

  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.1

なにか随分複雑に作ってますね。 そのまま使うならこんなかんじでしょうか? (計算式の入力と、AutoFillのやりかたを変えただけです) Sub 基準単価() Dim i As Integer Application.ScreenUpdating = False '1行目で検索 For i = Range("IV1").End(xlToLeft).Column To 1 Step -1 If InStr(Cells(1, i).Value, "基準単価") > 0 Then Cells(2, i).Formula = "=B2/A2" Cells(2, i).AutoFill Destination:=Range(Cells(2, i), Cells(2, i - 1).End(xlDown).Offset(0, 1)), Type:=xlFillDefault End If Next i Application.ScreenUpdating = False End Sub

acochaco
質問者

補足

ありがとうございます!書き方ひとつでこんなに すっきり実行できました。 もう1つだけ教えて下さい。。 実際には、 Cells(2, i).Formula = "=B2/A2" のところを、 Cells(2, i).Formula ="=Cells(2, i - 1) / Cells(2, i - 2)" としました。 =Cells(2, i - 1) / Cells(2, i - 600) と文字が返ってきます。。 セルの指定方法をすみませんが教えて下さい! お手数をおかけします。。

関連するQ&A

  • エクセルの行の削除を配列で高速化したい

    A列にID番号(012345等の文字列化した数字) B列に属性(A、B、C等の文字列) C列に数値  のようなデータがあります。 1行目はタイトル行です。 最優先されるキーをA列、2番目に優先されるキーをB列にして並べ替えてあります。 A列、B列のデータは重複するものがあります。 このデータを、 A列のID番号が同じだった場合、上の属性がA、次の行の属性がBの組み合わせだった場合のみ、下の行のC列の数値データを上の行のC列の数値に加算して、下の行を削除します。 以下のマクロを書き、うまくいきました。 Sub 集計() Dim i As Long, r As Long r = Cells(65536, 1).End(xlUp).Row Application.ScreenUpdating = False For i = r To 2 Step (-1) If Cells(i, 1) = Cells(i - 1, 1) Then If Cells(i, 2) = "B" And Cells(i - 1, 2) = "A" Then Cells(i - 1, 3) = Cells(i - 1, 3) + Cells(i, 3) Rows(i).Delete End If End If Next Application.ScreenUpdating = False End Sub しかし、データ数が多いので1分以上かかってしまいます。 多分、配列に取り込んで処理できれば飛躍的に高速化できるとは思うのですが、 V = Range(Cells(2, 1), Cells(r, 3)).Value と取り込んだあと、どう処理したらいいのかわかりません。 教えてください。

  • エクセルVBA 他シート選択・セルへ入力

    下記コード内で、シートを選択する際、マクロ呼出前は意図したとおり になるのですが、セル入力前だと上手くいきません。Activateにして もダメでした。根本的に理解していないようなので、教えてください。 よろしくお願いします。 シートAの実行ボタンをクリック Private Sub ButtonA_Click() Application.ScreenUpdating = False tempA = TextBox1 If ButtonB = True Then tempB = "10" End If Sheets("B").Select Call XYZ1 ' ----------------- (問題あり ここから)-------------- Sheets("B").Select Cells(1, 2) = 100 For i = 2 To 200 Cells(i, 2) = Range("B" & i - 1) - Range("A" & i) Next ' ----------------- (問題あり ここまで)-------------- Sheets("A").Select Call XYZ5 Application.ScreenUpdating = True End Sub

  • Excel VBA 列の最後の値を代入

    たびたびすみません。 指定したセルの、最終列の値を、任意のセルに入れたいのですが、 オブジェクトが必要です、というエラーがでます。 Sub 単価代入() Dim i As Integer Application.ScreenUpdating = False For i = Range("IV2").End(xlToLeft).Column To 1 Step -1 If InStr(Cells(2, i).Value, "単価") > 0 Then Cells(3, i).Value = Cells(3, i).End(xlToRight).Column.Value End If Next i Application.ScreenUpdating = True End Sub Cells(3, i).Value = のあとの指定方法がまずいのかと思いますが。。 どうぞ宜しくお願い致します。

  • Activeセルの最終列の値を代入し、セル最終行までコピーするには

    最終列の値の代入をここで教えていただいてできました。 J = Range("IV2").End(xlToLeft).Column For i = J to 1 Step -1 If InStr(Cells(2, i).Value, "単価") > 0 Then Cells(3, i).Value = Cells(3, J).Value End If Next i この、Cells(3, i).Value = Cells(3, J).Value を、 "単価"列の最終行までコピーするには どのような記述をしたらいいでしょうか? しばらく悩んでいますができません。。。 お力を貸してください。!

  • VBAで教えてください。

    以前ここで教えていただいたVBAで http://jisaku.155cm.com/src/1371930716_9b9006528605642980beed48a8998013b0731e4b.jpg のようにA列のテスト4をクリックしたときにC列のテスト4が一発で解るようにしたいです。 もちろん、テスト11をクリックしたときは、テスト4塗りつぶしは解除され、 テスト11が塗りつぶされるようにしたいです。 写真は塗りつぶししていますが、解るようにしたいだけなので、塗りつぶしにはこだわっていません。 あと、E、F、G列は解りやすく並べているだけで、実際はA、B、C列だけです。 それと、C列は関数を使って表示してあります。 という質問で Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'この行から Dim i As Long Range("C:C").Interior.ColorIndex = xlNone If Application.Intersect(Target, Range("A:A")) Is Nothing Or Target.Count <> 1 Then Exit Sub On Error Resume Next Application.ScreenUpdating = False ActiveSheet.Cells.interio.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, "C") = Target Then Cells(i, "C").Interior.ColorIndex = 3 End If Next i Application.ScreenUpdating = True End Sub 'この行まで をシートのコードに張り付ければいいですよ。と教えてくれたものがあるのですが、 A列でクリックした文字をC列からすべて見つけて反転してくれないようです。何個か反転してくれない ものが出てきてしまいました。 C列が何百行とかなってしまうと、すべての同じ文字を検索してくれないのでしょうか? ちなみに列がここに掲載しているものと違うので Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'この行から Dim i As Long Range("R:R").Interior.ColorIndex = xlNone If Application.Intersect(Target, Range("B:B")) Is Nothing Or Target.Count <> 1 Then Exit Sub On Error Resume Next Application.ScreenUpdating = False ActiveSheet.Cells.interio.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, "R") = Target Then Cells(i, "R").Interior.ColorIndex = 3 End If Next i Application.ScreenUpdating = True End Sub 'この行まで のCをRにAをBに変更して使ってます。 これがいけないのかな? よろしくお願いします。

  • 2つのVBAを組み合わせる方法

    お世話になります、2つのVBAを組み合わせる方法で迷っています。 1つ目が Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True End Sub です。 2つめが Private Sub Worksheet_Change(ByVal Target As Range)  Application.EnableEvents = True If Intersect(Target, Range("R8:R38")) Is Nothing Then Exit Sub Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End Sub です。2つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか?

  • エクセル重複行統合マクロの意味

    Tom04さんの回答で 以下のとても素晴らしいマクロがあり、 使用させていただきたいのですが、 詳細がわかりません。 少々編集して自分の書類に反映させていただきたく、 マクロの内容を教えていただけませんか? Sub test() 'この行から Dim i, j, k, L As Long Application.ScreenUpdating = False For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column + 1 For k = Cells(Rows.Count, j).End(xlUp).Row To 2 Step -1 If Cells(k, j) <> "" And WorksheetFunction.CountIf _ (Range(Cells(2, 1), Cells(k, 1)), Cells(k, 1)) > 1 Then L = WorksheetFunction.Match(Cells(k, 1), Columns(1), False) Cells(k, j).Cut Destination:=Cells(L, j) End If Next k Next j Next i For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If WorksheetFunction.CountA(Rows(i)) = 1 Then Rows(i).ClearContents End If Next i Application.ScreenUpdating = True End Sub 'この行まで

  • エクセル 最終行からの連続コピー

    エクセルで最終行から上に連続する10行(最終行含む)をコピーしたいです。 途中、空白行が含まれている場合でも、最終行を特定し、コピーできるようにするには、下記のコードにどう手を加えたらよいでしょうか? どなたかアドバイスをお願いします。 Sub Test()   Dim i As Long   Dim j As Integer   Dim rng As Range   With ActiveSheet     'フィルタ     .Range("A1").CurrentRegion.AutoFilter Field:=1          '行選択     With .AutoFilter.Range       For i = .Cells(.Cells.Count).Row To 2 Step -1         If .Rows(i).Hidden = False Then           If rng Is Nothing Then             Set rng = .Rows(i)           Else             Set rng = Union(rng, .Rows(i))           End If           j = j + 1         End If         If j >= 10 Then Exit For       Next i       'コピー       If Not rng Is Nothing Then         rng.Copy Worksheets("Sheet2").Range("A1")         Beep       Else         MsgBox "該当行は存在しません。", 48       End If     End With   End With   Set rng = Nothing なお、コードはこちらを参考にさせていただきました。 http://okwave.jp/qa3552420.html?ans_count_asc=1

  • ExcelのVBで、Rangeの範囲に任意のセル値を使うには

    VB初心者で行き詰っております。 前任者の作成したVBコードで、特定のセルの入力をテンキーで入力できるようにしています。 VBのコードについては、下記の通りとなっております。 Private Sub Worksheet_Change(ByVal Target As Range) Dim crng As Range Dim ttarget As Range Application.EnableEvents = False Set ttarget = Application.Intersect(Target, Range("C6:AG35")) If Not ttarget Is Nothing Then ttarget = Application.VLookup(ttarget, Worksheets("入力").Range("A1:B10"), 2,False) For Each crng In ttarget If IsError(crng) Then crng.Value = "" End If Next End If Application.EnableEvents = True End Sub ここで、シート内の範囲が変更となる(対象となる行が増減される)ことが発生します。 Set ttarget = Application.Intersect(Target, Range("C6:AG35")) ※この部分がRange("C6:AG37")や、Range("C6:AG33")などに変更となるということです。 その都度、VBの変更をかけると可能なのですが、より効率的にするため、入力という名前のシートに ある空きセルをうまく活用したいと考えております。 Range("C6:AG35")の部分で、任意のセルを参照する変数を利用するには、 どのように記述したらよろしいでしょうか? また、別法として、常に行数をカウントできる方法でも可能なのかもしれません。 最初の行に値するセルがC6から始まり、最終行よりも下は空白セルとなります。 とすれば、行数をカウントして変数に組み込むことも一つなのかもしれませんが、技術がないため、 思いつくだけにとどまっております。 アドバイスをいただければと思います。よろしくお願いします。

  • エクセル 最終行からの連続コピー

    * すぐに回答を! エクセルC20からI51までデータを1日1行ずつ入力します。 データが入力されている最終行から上に連続する10行(最終行含む)をコピーしたいのですが、最終行から10行上をどのように認識させたらいいのか、わかりません。Offsetなど試してみましたがダメでした。 よろしくお願いします。 Sub dataコピー() Dim i As Long Dim j As Integer Dim rng As Range '最後尾から10行前までを選択 With Worksheets("月").Range(Cells(20, 3), Cells(51, 10)) For i = Cells(Rows.Count, 1).End(xlUp).Row To -10? If rng Is Nothing Then Set rng = .Rows(i) End If j = j + 1 If j >= 10 Then Exit For Next i 'コピー If Not rng Is Nothing Then rng.Copy Range("M1") Beep Else MsgBox "該当行は存在しません。", 48 End If End With Set rng = Nothing End Sub コードはこちらを参考にしました ​http://questionbox.jp.msn.com/qa5440189.html

専門家に質問してみよう