• ベストアンサー

一度に、任意の列全体へ、関数をコピーするマクロは?

下記コードのように、 「 E 列 」 だけに実行するのではなく、 「 実行前 」 に、手動にて、好みの任意のセル1つに  「 関数 」 を貼り付けます。 そしてマクロを実行し、 下記 「 実行後 」 のようにするには、どのようなコードになりますでしょうか? 下記のような変数を組み入れるのだと思いますが、うまく出来ません。 ただ、先頭の 「 行番号 ( 変動しますが、例では60 ) 」 は、 手動にて貼り付けますので事前に解かっているとします。 また、 「 オートフィルタ 」 後に、使用する予定です。 何卒、よろしくお願い致します。 ------------------ Sub test() Range("E60").Select ActiveCell.FormulaR1C1 = "=RC[2]" Selection.AutoFill Destination:=Range("E60", Range("C65536").End(xlUp).Offset(0, 2)), Type:=xlFillDefault End Sub ------------------ Dim r As Range, base As Range Dim x, y Dim i Set r = Selection Set base = Selection.Cells(1, 1) x = r.Columns.Count y = r.Rows.Count ---実行前(オートフィルタ後)------------------ C列            E列  ・              ・  ・              ・ 2007/10/13       =G60    2007/10/13 2007/10/13 2007/10/13 2007/10/13 2007/10/14 2007/10/14 --実行後------------------- C列            E列  ・              ・  ・              ・ 2007/10/13       =G60    2007/10/13       =G60 2007/10/13       =G60 2007/10/13       =G60 2007/10/13       =G60 2007/10/14       =G60 2007/10/14       =G60

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

  • ベストアンサー
  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.1

こんな意味でしょうか? 関数を入れたセルを選択して実行します。(例の通りだと セルE60) Sub Test() Dim r As Range Set r = ActiveCell With ActiveSheet   .Range(r, .Cells(.Cells(65536, 3).End(xlUp).Row, r.Column)).Formula = r.Formula End With End Sub

oshietecho-dai
質問者

お礼

早速のご回答、誠に有難うございました。 不精な、文面をご理解して頂いて、有難うございました。 バッチリでございました。

その他の回答 (2)

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

こんにちは。 ご質問者さんは、難しく考えすぎなのだと思います。ご質問の内容からすると、単に、こういうように直せばよいと思います。質問内容からすると、列も任意の場合も含めるようですから、一応、相対位置を取らないといけませんね。Take it easy! Sub TestR() Dim Col As Integer Col = ActiveCell.Column - 3 'C列に対して ActiveCell.AutoFill Destination:= _ Range(ActiveCell, Range("C65536").End(xlUp).Offset(0, Col)), Type:=xlFillDefault End Sub

oshietecho-dai
質問者

お礼

こんばんは、 ご回答、誠に有難うございました。 質問内容の実例は、「絶対参照」で、私が間違っておりましたが、 実行結果は、希望通りでした。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

質問文が長々と書いてあるが、「D3(例えば)に入れた数式を、データ最下行まで、複写したい(VBAで)」ということではないの? 普通は実例を挙げることが判りやすさにつながるが、文章の方が意図が伝わりやすい例もある。 ーー 複雑なコードが書いてあるが、下記のように簡単で良いのでは。 番地を変化させないなら(質問例はこれらしい) Sub test01() d = ActiveSheet.Range("A65536").End(xlUp).Row For i = 3 To d ActiveSheet.Cells(i, "B").Formula = ActiveSheet.Cells(3, "B").Formula Next i End Sub ーー 下方向の複写なら(番地の行番号は変化)(マクロの記録が使える例) Sub test02() d = ActiveSheet.Range("A65536").End(xlUp).Row Range("B3").AutoFill Destination:=Range("B3:B" & d), Type:=xlFillDefault End Sub 質問の意図と違う場合は無視してください。

oshietecho-dai
質問者

お礼

ご回答、誠に有難うございました。 おっしゃられる通りでした。 質問内容の実例が間違っておりました。大変申し訳ありませんでした。 2007/10/13       =G60    2007/10/13       =G61 2007/10/13       =G72 2007/10/13       =G63 2007/10/13       =G64 2007/10/14       =G85 2007/10/14       =G86

関連するQ&A

  • 左のセルと違った値だけを、他のセルに書き込む

    ワークシートの任意の「G列とH列」において、G列の値と違っていたら、 P列にその違った値だけを書き込む。 「違った値」の選択まではなんとかできましたが、それからがどうも進みません。 何卒ご教示お願い致します。 ------------ Sub tes1() Dim r As Range, base As Range Dim x, y Dim i Set r = Selection Set base = Selection.Cells(1, 1) x = r.Columns.Count y = r.Rows.Count Selection.RowDifferences(ActiveCell).Select ・ ・ --------------- G   H ・・・・P 98   94   98 101  101    91   95   91 69   69 71   71 99   95   99 89   89 94   94 67   67 68   64   68

  • Excelマクロ オートフィルタ可視領域の特定部分をコピー

    何方か、回答をお願いします。 下記もマクロは 、B列:C列(B1:C1はタイトル)をオートフィルタに掛けて フィルタに掛かった一番上のデータをコピーして貼り付けているマクロですが。 やりたいことは、B1:C1のタイトルとフィルタに掛かった可視領域の一番上の データ(オートフィルタに引っかからないでデータが無い場合も有り)をコピー して貼り付けたいのですがどの様なコードを書けば良いのでしょうか。? Sub フィルタ() Range("B1:C1").Select Selection.AutoFilter Selection.AutoFilter Field:=2, Criteria1:=">=1e-6" Range("B1").CurrentRegion.Select On Error Resume Next Selection.SpecialCells(xlCellTypeVisible).Areas(2).Rows(1).Select Selection.Copy Range("K15").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.AutoFilter End Sub

  • VBAでオートフィルタの可視セルクリア後空白行削除がうまくできません

    VBA初心者です。 オートフィルターで抽出した行を削除したくて、以下のように書いたのですが、最後の一文でエラーになってしまいます。 ◆エラー内容◆ 実行時エラー1004 重複する選択範囲に対してそのコマンドを使用することはできません。 ◆書いたVBA◆   Range("A2").Select Selection.AutoFilter Field:=1, Criteria1:="=1111", Operator:=xlAnd 'オートフィルターで「1111」を抽出 Dim r As Range Set r = Range(Range("A3"), Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible) r.ClearContents 'A列の可視セルの値をクリア Range("A2").Select Selection.AutoFilter 'オートフィルターの解除 r.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'A列が空白の行は削除→ ココがエラーになります --------------------------------------------------------- 元のファイル構成は2行目に項目名で、3行目からデータが入っています。 いろいろ調べたのですが、よくわからなかったので教えていただければ 幸いです。 宜しくお願いします。

  • エクセルで列抽出できる関数かマクロを探しています。

    エクセルで列抽出できる関数かマクロを探しています。 マクロ初心者です。 表の形は、 A1  B1  C1  D1  E1 容量 0.1 5.5 11 22 形式 NF30 NF63 NF125 NF250 カバー TCS … と、電気部品のモータ容量と定格電流で抽出したいのです。 行で抽出するととても見づらく、列で一気に見れるように (制御器選定スケールの様に)したいのです。 スケールだけで形式は選定できるのですが、カバーも選定するために 毎回カタログで確認するのは仕事の効率が良くなく 表を作成しようと思いたったのですが・・・ いろいろ探してみたのですが、今のところ見つからず 今試しているのが、表を一度コピーして列行を入れ替えて 別シートにコピーしたものを作成してからオートフィルタをかけて 抽出したデータを別シートにもう一度列行を入れ替えて貼り付けする 方法しか考え出せていません。 質問なんですが、 上記のように列抽出できる関数やマクロがあるのか? それとも一度行抽出に変えて最後に列に戻すやり方の方が良いのか? 又、そのやり方を初心者なりに作成してみたのですが 1回目は出来ても、容量が変わるとエラーが出てきて出来ません。 Sub Macro1() Range("A31").Select ActiveCell.FormulaR1C1 = "=Sheet1!R5C2" Range("J31").Select ActiveCell.FormulaR1C1 = "=Sheet1!R6C2" Range("J32").Select ActiveWindow.SmallScroll Down:=-9 Range("A1:X24").Select Range("A1:X24").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ Range("A30:X31"), Unique:=False ActiveWindow.SmallScroll Down:=-12 Selection.Copy Sheets("Sheet1").Select Range("F1").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Sheets("Sheet3").Select Application.CutCopyMode = False ActiveSheet.ShowAllData End Sub たぶん、行列の入れ替えが上手くいかないのかなとは素人ながらに考えて 色んなサイトで調べてみていじってみるのですが、なかなか上手くいきません。 皆様、宜しくお願いいたします。

  • 列を2度コピーするマクロ

    B列をC列にコピーした後、A列をB列にコピーするという2段階コピーの下記マクロを、「新しいマクロの記録」を使って作りました。 しかし下記マクロは 列選択時の青反転が実行時に残って、使用感がいまひとつです。 「新しいマクロの記録」ではなく、もっとスマートなマクロはできないでしょうか? なお、列選択ではなく必要なセル数だけ選択すれば青反転はなくなると思いますが、行数が確定していないので列選択にしたいと思っています。 ついでに下記マクロについて質問です。 11行目はなぜ5行目とは違うのでしょうか?.PasteとPasteSpecial Pasteとの違いを教えていただければ幸いです。 Sub Macro1() Columns("B:B").Select Selection.Copy Columns("C:C").Select ActiveSheet.Paste Columns("A:A").Select Application.CutCopyMode = False Selection.Copy Columns("B:B").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A2").Select Application.CutCopyMode = False ActiveWorkbook.Save End Sub

  • このコードが、うまく実行できません!

    下記の実行後のようにしたのですが、うまく出来ません、 何卒、ご教示くださいませ。 EXEL 2002 です。 ------------------------------------ Sub 数に対してマークを付ける() Dim c As Range Workbooks(1)..Sheets(1).AutoFilter.Range.Cells(1, 5).Select For Each c In Range(Selection, Sheets(1).AutoFilter.Range.Cells(1, 5).End(xlDown)).Select Select Case c.Value Case Is = 0 c.Offset(0, -3).Value = "×" Case Is = 1 c.Offset(0, -3).Value = "△" Case Is = 2 c.Offset(0, -3).Value = "○" Case Else MsgBox "対象の数字がありません" End Select Next End Sub --実行前-------------------  A B C D E F G H 1 ・ ・ ・▼▼▼▼▼▼▼▼←オートフィルターのマーク ・       0 ・       2  ・       1 ・       0 50 ・ --実行後------------------  A B C D E F G H 1 ・ ・   ・▼▼▼▼▼▼▼▼←オートフィルターのマーク ・  ×    0 ・  ○    2  ・  △    1 ・  ×    0 50 ・ ---------- よろしくお願い致します。

  • このコードのどこが違ってますか?

    Windows XP Home Edition Excel 2002 左表(行方向)のコードは図のように問題なく動作しますので、 今度は、 右表(列方向)のように実行したいのですが、 最下記の「'---- 」間の箇所だけを変更すればいいかなと思いましたが、 どこが違ってますでしょうか? それと、(y * myCol) の基本的な日本語訳はどおなりますか? 何卒、ご教授お願い致します。 Sub 左表() Dim r As Range, base As Range Dim x, y Dim i, myCol Range("B3:D5").Select '省略 Set r = Selection Set base = Selection.Cells(1, 1) x = r.Columns.Count y = r.Rows.Count '------------------ For myCol = 1 To x - 1 base.Offset(0, myCol).Resize(y).Copy base.Offset(y * myCol) '●前記myColの各列を行方向(縦方向)に空白セルを詰めて、B列の下へ順次貼り付けていく '------------------ Next End Sub ========================== Sub 右表() '--変更箇所--------  For myCol = 1 To y - 1 base.Offset(myCol, 0).Resize(x).Copy base.Offset(myCol * x) '------------------

  • 現マクロに列の塗りつぶし追加したい

    マクロについては素人の私です。 図を参照いただきたいですが、J2にリストで「入金済み」と入力したとき下記のマクロでは F2 G2 I2 J2がグレーに塗りつぶしています。 但しE2には次のような式が入っています。 =IF(OR(B2="",C2=""),"",TEXT(B2,"yymmdd")&C2) このような式が入っていてもE2の塗りつぶしは可能でしょうか。可能ならば追加したいです。不可能ならE2は除きます。 もし可能ならばこれを B2 C2 D2 E2 もグレーでセルを塗りつぶすのを追加したいが下記のマクロをどうすればよろしいでしょうか。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim i As Long Dim r As Byte i = Sheets("入金記入").Range("B65536").End(xlUp).Row + 1 r = Target.Row If Target.Value = "入金済" Then With Sheets("入金記入") .Cells(i, 2).Value = Date .Cells(i, 3).Value = Cells(r, 3).Value .Cells(i, 4).Value = Cells(r, 4).Value End With End If End Sub ご指導の程、よろしく御願いします。

  • エクセル マクロで列を連続してコピーするにはどうしたらいいか教えてください

    初めて質問します。よろしくお願いいたします。 エクセルで上から下へ繰り返しコピーをする際のマクロは、例えば以下のようにLoopを使ってできると思うのですが、 例) Range ("A2:B92").select Selection.Copy GYOU1 = 93 Do Until GYOU1 = 2823 Range("A"+Format(GYOU1)).Select ActiveSheet.Paste GYOU1 = GYOU1 + 91 Loop 同じような連続の動作を横方向(列方向)に行うにはどういうマクロを組めばよいか教えてください。例えば、A2:A10 -> C2:C10 -> E2:E10のように2列間隔で横方向にコピーペーストしていくマクロです。 よろしくお願いいたします。

  • RNKU関数をマクロで記述したいのですが?

    RNKU関数をマクロで記述したいのですが? マクロを勉強しようと思いネットや本を見ながら試行錯誤しております。RANK関数と同じことをしようと思い調べながら実行したのですがうまくいきません。型が一致しませんと出るのですが、ヘルプを見ても良く分からなかったので、だれか教えて頂けませんでしょうか。 Sub Macro1() Range("A1:A17").Select For Each r In Selection Range("B1:B17") = Application.WorksheetFunction.Rank(r, Selection, 1) Next r End Sub A列の順位をB列に表示しようとしました。

専門家に質問してみよう