[[20040701131021]] 『数式の参照で書式までもコピーしたい・・・』(寄席丸) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『数式の参照で書式までもコピーしたい・・・』(寄席丸)

はじめまして、早速ですが質問があります。

仮に『A1』のセルに「○○建設」と文字を打ち込みます。そこに『A10』のセルに(=A1)と打ち込んで「○○建設」という『A1』の文字を『A10』に表示させてたいのですが、文字と一緒に『A1』の書式(文字の太さや右詰め、中央、左詰め程度)も参照したいのですが、私の知識ではできませんでした。過去ログも参照しました、背景色等はあったのですが、書式の参照という項目は見つけられませんでした。どなたか教えて頂けないでしょうか?お忙しいとは思いますが、よろしくお願いします。


VBA初心者でコードが適切かどうかは疑問ですが、

わからないなりに頑張ってみました。

ちょっと恥ずかしいのですが、一応エラーもなく動いてくれたので・・・

シートのコード表にコピペしてみてください。

Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case Target.Address
                Case Is = "$A$1"
                          ActiveSheet.Range("A10").Select
                Case Else
                 Exit Sub
    End Select

    If Range("A1").Value = Clear Then
        Range("A10").Delete

    Else
        Range("A1").Select
        Selection.Copy
        Range("A10").PasteSpecial Paste:=xlPasteAll

    End If
     Target.Offset(1, 0).Select
End Sub

すみませんが、直すところご指摘いただければ勉強になります。(HISA)


 衝突しました、単にコピペのことでしたか?
 一応書いたので...
 ******************

 関数なら
 文字配置の検査には
 =CELL("prefix",範囲)  を使います。
 ○○建設 が A1 として、
 例えば B1 に
 =CELL("prefix",A1)

 直接どんな配置かを調べるには、
=IF(CELL("prefix",A1)="'","左",IF(CELL("prefix",A1)="^","中",IF(CELL("prefix",A1)="""","右")))
 等とするのもいいかもしれません。

 なお、参照させた A10 では、
 =CELL("prefix",A10) は答えを返してくれません。  (jun53)

 また
 =CELL("prefix",範囲)
 は、書式を変更した場合
 再計算(F9キー)させないと検査してくれませんね。

 VBAご希望でしたらゴメンナサイ。  (jun53)

(寄席丸)
早速の回答ありがとうございます。ですが・・・うまくいきませんでいした。もしかした私の質問
の仕方と知識のなさがうまくいかない原因だと思いますので、質問を再度書き込ませていただき
ます。

          A                     B     C     D
  1     ○○建設  ←中央揃えで
  2
  ・
  ・
 10 ○○建設 ←左揃えになってしまう。(A1を中央揃えに指定したらA10中央揃えにしたい)
 11                 (またA1が右詰めになったらA10も右詰めにしたい) 
 12
  ・
  ・
 20 ○○建設 ←左揃えになってしまう。(A1を中央揃えに指定したらA20中央揃えにしたい)
                   (またA1が右詰めになったらA20も右詰めにしたい)
                   
上記のように『A1』に文字を入力して『A10』、『A20』を表示するときにA1の書式(文字の位
置)もおなじにする。というようにしたいとおもいます。また『A1』に文字がが無いときは
『A10』、『A20』に何も表示したくないので以下のような式を考えて入力してあります。
=IF($A$10=0,"",$A$10)

あと(HISA)様にはVBAまで書いて頂き大変ありがとうございます。しかし私自身VBAの使い方自体
がよくわかりませんので、上記のプログラムを確かめる術を知りませんので、VBAの使い方及び導
入の仕方の方法を教えていただければ幸いです。(寄席丸)


該当するシート名のタグを右クリックして「コードの表示」を選択して

開いたウィンドウ(右側の空白部分)に貼り付けてください。

A20のセルも同様みたいですので、

ちょっと変えました。

Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case Target.Address
                Case Is = "$A$1"
                          ActiveSheet.Range("A10").Select
                          ActiveSheet.Range("A20").Select
                Case Else
                 Exit Sub
    End Select

    If Range("A1").Value = Clear Then
        Range("A10").Clear
        Range("A20").Clear

    Else
        Range("A1").Select
        Selection.Copy
        Range("A10").PasteSpecial Paste:=xlPasteAll
        Range("A20").PasteSpecial Paste:=xlPasteAll

    End If
    Target.Offset(1, 0).Select
End Sub

(HISA)


 衝突してしまいました。

 ご希望通りに動くかはわかりませんが、一度お試しになってください。
 A1を変更した時点で、A1セルをダブルクリックしてください。

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Selection.Copy   'すいませんここが抜けてました。
   Selection.DirectDependents.Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
 End Sub

 上記をALT+F11で開いたVBA画面で表示−プロジェクトエクスプローラを開き
 該当Bookの該当シートをダブルクリックして出てくる白い場所に貼り付けてください。

 なお、試す場合にはブックのバックアップをとっておいてください。
 元に戻せませんので^^;

 あと、A1を参照しているすべてのセルが対象になります。

 (川野鮎太郎)


すてきです。

こんなにスマートにできるんですね。

日々勉強です。

このセルがこなったらこうして・・・

なんて考えているとどんどん構文が膨らんじゃいますね。(HISA)

寄席丸さん大丈夫ですか?

私(HISA)が作ったほうは、A10&A20に=A1というのをセルに入れないでできます。

川野さんが作ってくれた方は、A10&A20の=A1と入力されたままで

A1をダブルクリックすると書式がコピーされます。

(HISA)


 すいません。
 書いては見たものの、私の提示したものは他のセルでダブルクリックしたときにも
 動いてしまい、思わぬ結果になるやもしれませんので忘れてください(^_^A;
 ワークシートではなく、標準モジュールに入れてボタンで動作だったら問題ないのでしょうけど・・・。
 (川野鮎太郎)

(寄席丸)
お二人ともありがとうございます。VBAが扱えるって素敵ですね。私もこれを機会にまじめにVBAを覚えようかな?なんか出来ることが多くなって世界が広がりそうな感じがするので・・・
まえおきが長くなってしまいましたが結果を報告します。
(HISA)様のVBAはうまくいきました。
(川野鮎太郎)様のもうまくいきました。
お二人お忙しいところありがとうございました。
今回は(川野鮎太郎)様のVBAで処理したいと思います。しかし二人ともとても親切ですね。一度も
逢ったことのない私にこんなに親切にしてくれるなんて・・・
私が女性だったら惚れちゃいそうです!?^^;


私も助けて欲しいことのほうが多いです。

少しはお役に立てたようでうれしいです。

ちなみに私は女性です。^^V (HISA)


 A1 の値の変化にあわせて、A10,A20 にコピーするだけならこのように出来ます。

 changeイベントは、書式の変更では実行されないので、
 書式を設定してから、セルの値を変更して下さい。

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> Range("A1").Address Then Exit Sub
    Target.Copy Range("A10,A20")
 End Sub

 ちなみにダブルクリックのときは、

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address <> Range("A1").Address Then Exit Sub
    Target.Copy Range("A10,A20")
    Cancel = True
 End Sub

 以上、ご参考までに・・
   (INA)

(寄席丸)
(INA)様ありがとうございます。参考にさせて頂きます。

(寄席丸)
大変あつかましいんですが、

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Selection.Copy 
   Selection.DirectDependents.Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
 End Sub

(川野鮎太郎)様の書いて下さったVBAです。

上記のVBAだと同じシート内でしか、書式が変更されませんでした。シートをまたいでの書式のコピーは
どのようにすればよいのでしょうか?
大変あつかましいお願いだとはおもいますが、回答をお待ちしております。


 >シートをまたいでの書式のコピーはどのようにすればよいのでしょうか?

 「マクロの記録」を試してみては如何でしょうか?

  (INA)

(INA)様早速の回答ありがとうございます。回答にあった「マクロの記録」とは具体的にどのよ

うにすればよいのでしょうか?わたし自身初心者なので、できれば詳しい解説をお願いしたい


 こちらに統合しました。
 (kazu)


『RE数式の参照で書式までもコピーしたい・・・』(みゆ)

みなさん、はじめまして。エクセル初心者のみゆです。

エクセルでどうしてもやりたいことがあったので、会社の先輩に教えてもらってこのページに

たどりつきました。

さて、質問なんですが、一度(寄席丸)さんがみなさんに質問していた内容とほとんど同じで

す。

私もシートをまたいで、数式の参照で書式までコピーしたいんです。

同じシート内の数式の参照で書式までコピーは(川野鮎太郎)さんが書いて下さったVBAでうま

くいったんですが、シートをまたいで、数式の参照で書式までコピーがうまくいきませんでし

た。

(INA)さん「マクロの記録」に書いてあったHPを見てもまだまだ私の理解不足が多く具体的な

やり方が不明です。このHPを教えてくれた先輩も「うーむ」と言ったまま出張にいってしまい

ました・・・

どなたか詳しく教えて頂きたいと思います。


 関連する質問はリンクを貼っておかないと、
 いきなり見た人には意味が分からないですよ。 
 [[20040701131021]]

 さてマクロの記録の意味が分からないのでしょうか?
 マクロの記録は、Excel上の操作を 録音(記録)して 再生(実行)するようなものです。

 マクロにして自動化したい作業を、記録してあげれば、
 その記録されたマクロを実行することにより
 同じ操作を簡単に再現することが出来ます。

 マクロの記録で、自動作成されたVBAコードを見ると分かりますが、
 シート間でのコピーは

 Worksheets("Sheet1").Range("A1").copy
 Destination:=Worksheets("Sheet2").Range("A1")

 のような感じです。 

  (INA)


 おはようございます。
 私が前回(寄席丸)さんの質問で、シートをまたがっての書式のコピーが私の能力では出来ないと申し上げた件ですが、
 私の提示したマクロは仮にA4を参照しているセルがB6、C8などすべてのセルに書式もコピーできるものだったのですが。
 しかし、シートをまたがると実行不可能なのですが、どのようにすれば可能か私も知りたいところです(^_^A;
(川野鮎太郎)


(寄席丸)
おはようございます。寄席丸です。上記の質問ですが私もうまくいっていません。

正直今回は、シートの頭に原型をつくりシート毎にコピーしています。

でもちょっと不便を感じています・・・

(川野鮎太郎)さんと同じくどうすれば可能か知りたいです。・・・
と思います。(寄席丸)


 申し訳ないですけど。私の技量では他のシートへの書式のコピーは出来ないようで・・(^_^A;
 どなたか詳しい方の回答が得られる事を願っています。m(_ _)m
 (川野鮎太郎)


 >「マクロの記録」とは具体的にどのようにすればよいのでしょうか? 

 こちらが参考になると思います。マクロを修得するうえで、最初に使う機能です。

http://www.sanynet.ne.jp/~awa/excelvba/kouza.html

http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_020.html

   (INA) 

 マクロの記録から↓こんなものを作ってみました。
 どうでしょう?
 標準モジュールに貼り付けてみて下さい。
 Sub Macro1()
 '
 ' Macro1 Macro
 ' マクロ記録日 : 2004/7/5  ユーザー名 :夏目雅子似

    Dim MyRange As Range  'コピー元の範囲

    Dim MyRrange As Range  'コピー先の範囲

    On Error Resume Next
    'インプトボックスで変数コピー元を取得
    Set MyRange = Application.InputBox("コピー元を選択して下さい。", Type:=8)
    '無かったら、中止
    If MyRange Is Nothing Then Exit Sub
     'インプトボックスで変数コピー先を取得
    Set MyRrange = Application.InputBox("張り付け先を選択して下さい。", Type:=8)
    '無かったら、中止
    If MyRrange Is Nothing Then Exit Sub
    'コピー元をコピー
    MyRange.Copy
    'コピー先に貼り付け 今回の場合は書式のみ
    MyRrange.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    'コピーモードの解除
    Application.CutCopyMode = False

    Set MyRange = Nothing '変数のクリア

    Set MyRrange = Nothing  '変数のクリア

 End Sub


 ↑
 どなたなのでしょうか?

 私は質問の内容を勘違いしていたのでしょうか・・

 コピー&貼り付け のマクロにおいて、 セルの位置が決まっておらず
 「書式のみ貼り付け」を頻繁に使用するので、
 操作を短縮したいということだったのでしょうか?

 任意のセル(Selection) で マクロを実行したいのであれば、
 マクロにショートカットキーを割り当てればよいと思います。

 Selectionでコピー元を指定すると、マクロのボタンを押したときに
 コピー元の指定の点線が消えてしまうので、
 ショートカットキー(ctrl + M など)を設定すればよいと思います。

 わたしはアドインで ctrl + M を「値のみ貼り付け」にしてあります。

  (INA) 

 失礼しました。夏目雅子似です。
 別に、深い意味はありません。
 ただ、こんな方法も、という程度です。
 でも、これなら、マウスで直接やった方が早いですよね^^;
 失礼しました。

 夏目雅子似さんでしたか。(^o^)

 わたしは今だにこの質問の内容を理解できておりません。(-_-;)

 Change や BeforeDoubleClick などのイベントマクロを利用するのであれば、
 対象となるセルの位置は決まっているように思えます。
 だとすれば、まえに私が記した方法で問題ないと思いますし、
 任意の位置で使用するなら、以下のようなマクロに
 ショートカットキーを割り当てればよいと思います。 

 [書式のみコピーの場合]
 Sub PasteFormats()
 On Error Resume Next
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
 End Sub

 まだ勘違いしているのかな・・・・
 
  (INA)

衝突しました。
 質問者ではありませんが、私のマクロを実行しての追加質問のようですので、
 質問の意味を一度整理させてください。(違ってたらすいません)

 Sheet1                   
    A     B    C    D       H    I    J    K
  ┌─────┬───┬───┬───   ┌────┬───┬───┬───
 1│工事費  │   │   │      │=A1   │   │   │
  ├─────┼───┼───┼───   ├────┼───┼───┼───
 2│ A工事  │   │   │      │    │   │   │
  ├─────┼───┼───┼───   ├────┼───┼───┼───
 3│ B工事  │   │   │      │    │   │   │
  ├─────┼───┼───┼───   ├────┼───┼───┼───
 4│ C工事  │   │   │      │    │   │   │
  ├─────┼───┼───┼───   ├────┼───┼───┼───
 5│材料費  │   │   │      │=A1   │   │   │
  ├─────┼───┼───┼───   ├────┼───┼───┼───
 6│     │   │   │      │    │   │   │
  ├─────┼───┼───┼───   ├────┼───┼───┼───

 Sheet1                   Sheet2
    A     B    C    D        C     D    E    F
  ┌─────┬───┬───┬───   ┌─────┬───┬───┬───
 1│工事費  │   │   │      │     │   │   │
  ├─────┼───┼───┼───   ├─────┼───┼───┼───
 2│ A工事  │   │   │      │=Sheet1!A1工事費 │   │=Sheet1!A1工事費
  ├─────┼───┼───┼───   ├─────┼───┼───┼───
 3│ B工事  │   │   │      │=Sheet1!A5材料費 │   │
  ├─────┼───┼───┼───   ├─────┼───┼───┼───
 4│ C工事  │   │   │      │     │   │   │
  ├─────┼───┼───┼───   ├─────┼───┼───┼───
 5│材料費  │   │   │      │     │   │   │
  ├─────┼───┼───┼───   ├─────┼───┼───┼───
 6│     │   │   │      │     │   │   │
  ├─────┼───┼───┼───   ├─────┼───┼───┼───

 などの表があり、Sheet1のA1セルの書式を変更したらSheet1のH1,H5やSheet2のC2,F2のセルの書式も
 変わるようにとのことではないでしょうか。
 変更したいセルは決まっていても、複数あるなどで自動的に出来ないかとのことではないかと(^_^A;
 (川野鮎太郎)

 私がこの Selection.DirectDependents.Select を使ったマクロを使用するのは、
 1ページ目の総括表(仮にA1)にA5000のセルの値をリンクさせてるときに、
 あとで検算したりする場合に、A5000のセルにジャンプさせるときに使っています。
 その応用で作ったのですが、シートをまたいでのコピー方法がわからないと言ったのは
 A1の値がSheet2のC3000の値を持ってきてる場合には、エクセル標準のジャンプでは、
 C3000に飛んでくれませんので、やり方がわからないのです(^_^A;
 (川野鮎太郎)

 >DirectDependents
 は、ヘルプに
 [対象となるセルを直接参照している参照先 (1 レベルのみ) の]
 とあるので、仕様上無理のようですね。

 それよりも、 せっかくExcelを使っているのですから
 >あとで検算したりする場合に
 これをマクロ化しておくほうが、効率的だと思います。

  (INA)

 はい、確かにその通りです^^
 もうかなり前に作ったもので、何がどうなってるのか思い出すのが困難ですが、
 以下のもので運用しております。

 Sub 下層へ移動()

 row1 = ActiveCell.Row
 col1 = ActiveCell.Column
 len1 = Len(ActiveCell.FormulaR1C1)
 len2 = Mid(ActiveCell.FormulaR1C1, 2, 1)

 If len2 = "'" Then
   ii = Application.Search("!", ActiveCell.FormulaR1C1, 1)
       va1 = Mid(ActiveCell.FormulaR1C1, 3, ii - 4)

   rr = Application.Search("R[", ActiveCell.FormulaR1C1, 1)

   cc = Application.Search("C[", ActiveCell.FormulaR1C1, 1)'ここの値が取得できてない。
   R1 = Mid(ActiveCell.FormulaR1C1, rr + 2, cc - rr - 3)
   c1 = Mid(ActiveCell.FormulaR1C1, cc + 2, 1)
   c2 = Mid(ActiveCell.FormulaR1C1, cc + 2, 2)

     Sheets(va1).Select

 Else

   ii = Application.Search("!", ActiveCell.FormulaR1C1, 1)
       va1 = Mid(ActiveCell.FormulaR1C1, 2, ii - 2)

   rr = Application.Search("R[", ActiveCell.FormulaR1C1, 1)
   cc = Application.Search("C[", ActiveCell.FormulaR1C1, 1)
   R1 = Mid(ActiveCell.FormulaR1C1, rr + 2, cc - rr - 3)
   c1 = Mid(ActiveCell.FormulaR1C1, cc + 2, 1)
   c2 = Mid(ActiveCell.FormulaR1C1, cc + 2, 2)

   Sheets(va1).Select

 End If

 If c1 = "-" Then

   Cells(row1 + R1, col1 + c2).Select

 Else

   Cells(row1 + R1, col1 + c1).Select

 End If

 End Sub

 上記は、総括表の任意のセルに入ってる参照元(○○工事内訳書のセル)にジャンプするマクロです。

 ただひとつ、参照先のセルと参照もとのセルが同じ列の場合に実行時エラーになってしまいます。 
 (川野鮎太郎)

 (・_・o)ン?ということは・・・
 このエラーが解決できれば、先の
    Selection.Copy '(1)

    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False '(2)

 を追加すれば、質問者の方の要望がかなうのかな?(^_^A;
 (川野鮎太郎)

 (寄席丸)
 みなさん返信が遅れてすみませんでした。(寄席丸)です。実は事故に遭ってしまい『入院』と
 『右手骨折』と『車全損』の被害に遭いました・・・さて元は私の質問から始まったことだっ
 たのですが みなさんのありがたい解答により同じシートでは書式のコピーが出来るようになりま
 した。ありがとうございます。
 さて、『シートをまたがって書式のコピー』ですが、(鯉野鮎太郎)さんが整理してくださった内容
 が、私の質問内容です。そこで(鯉野鮎太郎)さんのVBAを合体したもの

 Sub 下層へ移動()

 row1 = ActiveCell.Row
 col1 = ActiveCell.Column
 len1 = Len(ActiveCell.FormulaR1C1)
 len2 = Mid(ActiveCell.FormulaR1C1, 2, 1)

 If len2 = "'" Then
     ii = Application.Search("!", ActiveCell.FormulaR1C1, 1)
         va1 = Mid(ActiveCell.FormulaR1C1, 3, ii - 4)

     rr = Application.Search("R[", ActiveCell.FormulaR1C1, 1)

     cc = Application.Search("C[", ActiveCell.FormulaR1C1, 1) 'ここの値が取得できてない。
     R1 = Mid(ActiveCell.FormulaR1C1, rr + 2, cc - rr - 3)
     c1 = Mid(ActiveCell.FormulaR1C1, cc + 2, 1)
     c2 = Mid(ActiveCell.FormulaR1C1, cc + 2, 2)

     Sheets(va1).Select

 Else

     ii = Application.Search("!", ActiveCell.FormulaR1C1, 1)
         va1 = Mid(ActiveCell.FormulaR1C1, 2, ii - 2)

     rr = Application.Search("R[", ActiveCell.FormulaR1C1, 1)
     cc = Application.Search("C[", ActiveCell.FormulaR1C1, 1)
     R1 = Mid(ActiveCell.FormulaR1C1, rr + 2, cc - rr - 3)
     c1 = Mid(ActiveCell.FormulaR1C1, cc + 2, 1)
     c2 = Mid(ActiveCell.FormulaR1C1, cc + 2, 2)

     Sheets(va1).Select

 End If

 If c1 = "-" Then

     Cells(row1 + R1, col1 + c2).Select

 Else

     Cells(row1 + R1, col1 + c1).Select

 End If

    Selection.Copy  '(1)

    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False  '(2)

 End Sub

 というVBAをシート右クリック『コードの表示』で各シートにコピーしたのですが、うまくいきませんでし
 た。上記VBAはどこがちがうのか、ご指示をいただければ幸いです。
 よろしくお願いします。

 交通事故ですか、命に別状が無く何よりでしたね(^_^A;
 問題の件ですが、まったく逆のことに気づきましたm(_ _)m
 私の提示したものは、下層への参照ですから、今回の質問とは逆でした(>_<;)
 よって、私の提示したマクロは忘れてくださいませ。
 逆の上層への参照のマクロは思い浮かびません。
 まことに申し訳ございませんでした。
 いつのまにか鯉野鮎太郎になった(川野鮎太郎)^^;

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.