[[20170111223723]]　『シートの最終行まで特定の列だけ数式のコピーをす』（Nao）　ページの最後に飛ぶ

『シートの最終行まで特定の列だけ数式のコピーをするマクロについて』（Nao）

初めまして。よろしくお願いいたします。
件名にも記載しましたが、シートの最終行まで
特定の列だけ数式のコピーをするマクロを作成したいと思います。

A,B,C列には、文字列が入力されていて、
B,C列には空欄もあったりしますが、A列には空欄なく文字列が入力されています。
行数についてはだいたい、1000行から20000行ぐらいまでは入力されることが多いですが、確定した行数はありません。

このような状態で、D,E,F列の1行目・2行目に以下の文字、数式を入力するコードを入力しました。
Cells(1, 4) = "差額"
Cells(1, 5) = "割合"
Cells(1, 6) = "改定価格"
Cells(2, 4) = "=b2-c2"
Cells(2, 5) = "=d2/b2"
Cells(2, 6) = "=IF(d2<0,B2,C2-1)"

この状態から、D,E,F列の2行目の数式をA列の最終行までコピーするマクロを作成したいと思います。

手入力だと、最終行を確認し、D2のセルを選択して、F5を押して、F列の最終行を入力し、Shiftを押しながらOKし、D2からF列最終行の範囲を選択、その後に「フィル」「連続データの作成」「オートフィル」を選択して、OKをする作業になります。

よろしくお願いいたします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 かならずしも、この手順でなくても処理はできますが、この手順を、マクロ記録しますと

    Range("D2:F●").Select
    Selection.DataSeries Rowcol:=xlColumns, Type:=xlAutoFill, Date:=xlDay, _
        Trend:=False

 こんなコードが生成されますね。
 この領域を動的に取得すればＯＫなんですが。

 たとえば

    Range("A2", Range("A" & Rows.Count).End(xlUp)).EntireRow.Columns("D:F").Select
    Selection.DataSeries Rowcol:=xlColumns, Type:=xlAutoFill, Date:=xlDay, _
        Trend:=False

（β） 2017/01/11(水) 23:04

 ちなみに、こんな書き方でも。

 Sub Sample()
    Range("D1:F1").Value = Array("差額", "割合", "改定価格")
    With Range("A2", Range("A" & Rows.Count).End(xlUp)).EntireRow
        .Columns("D").Formula = "=B2-C2"
        .Columns("E").Formula = "=D2/B2"
        .Columns("F").Formula = "=IF(D2<0,B2,C2-1)"
    End With
 End Sub

（β） 2017/01/11(水) 23:10

βさん、ありがとうございます！
きれいに作成することができました！
「ちなみに」のほうで作成させていただきました！

また、もし可能でしたら、上記処理をした後、
1 E列の書式を「％」に設定、
2 A列からE列にフィルターを設定、
3 E列を「昇順」に並び替え、
4 D列を「数値フィルター」で「3000以下」を表示、
5 B列からE列を非表示に設定、
6 表示されているA列とF列の2行目から最終行までコピー

ということを「マクロの記録」で以下の通り行ってみたのですが、

ActiveSheet.Range("$A$1:$F$2143")
というところは汎用性がないと思うのですが、
うまく修正する方法を教えていただけないでしょうか？
よろしくお願いいたします！

Sub Macro1()
'
' Macro1 Macro
'

    Columns("E:E").Select
    Selection.Style = "Percent"
    Range("A1:F1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("E1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$F$2143").AutoFilter Field:=4, Criteria1:="<=3000" _
        , Operator:=xlAnd
    Columns("B:E").Select
    Selection.EntireColumn.Hidden = True
    Range("A2:F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
End Sub
（Nao） 2017/01/12(木) 09:38

 レス遅れてごめんなさい。
 追加質問、見落としていました。

 マクロ記録をとった後、それをブラッシュアップするポイントは、コメントにある　固定領域の変動化と
 もう１つ、『操作』をコピーするマクロ記録の宿命で、○○.Select --> Selection.□□　といったペアが
 どっさりと生成される部分の手当て。

 ○○.Select --> Selection.□□ という記述の 99.9% は ○○.□□　と書き直すことができます。
 なんとか.Select と書いて　Selection.なになに　と処理したり、　なんとか.Activate とかいて
 ActiveCell や ActiveSheet を前提にした処理したりするのは、『状況依存コード』といって、あまり好ましくないものです。

 並び替え、2007以降、Sortオブジェクトに対するコードが生成されるようになっていますので、ここは
 このままにしてあります。個人的な好みとしては、2003までのSortメソッドコードがシンプルで好きなんですが。

 オートフィルター領域の規定、以下では Range("A1").Autofilter としたり Range("A1").CurrentRegion としたりしています。
 そのほかに ActiveSheet.Autofilter.Range という記述で（そのリストがA1から始まっていなくても）領域が取得できます。

 で、Intersect(その領域,その領域.Offset(1)) で、タイトル行を除いた中身の領域が取得できます。

 なお、抽出行がなかった場合、コピペすると、全データコピペになってしまいます。
 そこも手当てしました。

 あぁ、もう１つ。
 最初に、A列からF列までに対してオートフィルターを設定していますが、もし、何らかの理由で、オートフィルターが残りっぱなしの場合
 このコードは、オートフィルターの解除になってしまいます。そうすると、以降の処理で不具合がでますので
 先頭で、念のためオートフィルターの無条件解除を行いました。

 Sub Sample2()

    ActiveSheet.AutoFilterMode = False  '念のため追加

    Columns("E:E").Style = "Percent"
    Range("A1:F1").AutoFilter

    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("E1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Range("A1").AutoFilter Field:=4, Criteria1:="<=3000" _
        , Operator:=xlAnd
    Columns("B:E").Hidden = True

    If Range("A1").CurrentRegion.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Intersect(Range("A1").CurrentRegion, Range("A1").CurrentRegion.Offset(1)).Copy
    End If

 End Sub

（β） 2017/01/13(金) 07:33

 参考までに、オートフィルター領域を シート.AutoFilter.Range にした上で、Sortメソッドを使ったコードです。
 なお、念のため、抽出行がなかった場合、クリップボードをクリアしました。

 Sub Sample3()
    Dim aR As Range

    ActiveSheet.AutoFilterMode = False  '念のため追加

    Columns("E:E").Style = "Percent"
    Range("A1:F1").AutoFilter

    Set aR = ActiveSheet.AutoFilter.Range   'タイトル行含んだリスト領域

    aR.Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlYes

    aR.AutoFilter Field:=4, Criteria1:="<=3000"
    Columns("B:E").Hidden = True

    If aR.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Intersect(aR, aR.Offset(1)).Copy
    Else
        Application.CutCopyMode = False '念のため
    End If

 End Sub

（β） 2017/01/13(金) 08:28

βさん、ありがとうございます！！！！
どちらもきれいにデータが出来上がりました！！
２ついただいたどちらもうまく作動しまして、
あまり違いを認識できていないのですが、2つ目を利用させていただきます。
私は本当に素人なのでなかなか専門用語を理解できないところはありますが、
教えていただいたことを次に活かしていきたいと思います。
本当にありがとうございました！

（Nao） 2017/01/13(金) 11:45

コメント返信：

[ 一覧(最新更新順) ]

[[20170111223723]] 『シートの最終行まで特定の列だけ数式のコピーをす』（Nao） ページの最後に飛ぶ

[[20170111223723]]　『シートの最終行まで特定の列だけ数式のコピーをす』（Nao）　ページの最後に飛ぶ