[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ある値の時そのセルと同じ書式を適用したい』（まーちん）
入力したセルの値が、あるいくつかのセルの値のうちのひとつと同じ場合にそのセルと同じ書式を適用したい。
例えばA1からI1までにデータを入力しそれぞれ文字色やセルの色、罫線などの書式を設定します。 これらが元データとなります。
そして他のセルにデータを入力した際、これらの中の一つと同じデータが入力された場合に自動的に同じ書式を適用したいのです。
簡単に言うと、コピーアンドペーストを自動的にやりたいという事なんです。
できれば入力した直後に適用されるような形が望ましいのですが、こんな事は可能でしょうか。 どなたか御教授よろしくお願い致します。
条件付書式で同じようなことができるのですが、3つまでしか条件を指定できないので3つ以上の条件を指定したいので利用できません。
条件付書式はとても便利なんですが、3つしか条件が指定できないのは惜しいと思うのは私だけでしょうか？
「図のリンク貼り付け」で限界突破することが出来ます。 （面倒くさい、重い、遅いの三拍子そろってしまいますが）
条件がA1からI1の値で九つあるとして、シートを四つ用意します Sheet1 表示用 Sheet2 入力用のシート Sheet3 入力用のシートを参照 Sheet4 〃
●Sheet3、Sheet4の設定 必要範囲にSheet2への参照式を埋め込みます。 それぞれのA1セルに=Sheet2!A1として該当セル範囲へ貼り付け。 （必要範囲だけにしておいたほうが良いです） また、参照式によって本来の空白セルに「0」が表示されてしまうので、 「ツール」「オプション」の表示タブで「ゼロ値」のチェックをはずします。 これでSheet2の内容（セルの値）がSheet3、Sheet4に反映されます。
●条件付書式の設定 Sheet2、Sheet3、Sheet4、を作業グループにします。 （シート見出しをCtrlキーを押しながら選択）
Sheet2で必要範囲にA1からC1の値に対応する条件付書式を設定します。
作業グループを解除し、 Sheet3の条件付書式をD1からF1の値に対応する条件付書式 Sheet4の条件付書式をG1からI1の値に対応する条件付書式 に編集します。
●Sheet1へ図をリンク貼り付け 次に表示用のSheet1へそれぞれのシートの表示を画像として反映させます。
Sheet2の使用する範囲をコピーSheet1のA1セルを選択し、 Shiftキーを押しながらメニュー「編集」→「図のリンク貼り付け」 Sheet3、Sheet4についても同様にSheet1へ「図のリンク貼り付け」を行います。
入力はSheet2で行い、表示をSheet1で行うことによって 条件付書式を拡張することが出来ます。 条件による書式が増えたり、データ量が多かったりすると それだけ参照式やシートが増えてしまうので、 かなり重くなること間違いなしです。 そのへん注意してご検討ください。 (KAMIYA)
まーちんさん、こんな方法もおますわ。 ただ、これにも弱点はありましてナ、コピーの元になるセルから上に書式をコピーしよ としてもあきまへんわ。ハッキリ検索範囲が指定でけたら問題おまへんけど、不特定多 数やと検索方向が最上列〜右方向になってますさかいなぁ...。 旨く使えばっちゅう条件付きですわ、えぇ。 まぁ、試してみる価値はあると思いまんねんけどナ。 ほな...（弥太郎） Alt+F11 Sheet1 選択 F7 下のコードをコピーですわ。 先に書式とそのデータはそれぞれせるに入力しておいておくんなはれや。 後は任意のセルに入力してくだはれ。 ほな...（弥太郎）
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
For Each c In Range("a:iv")
If c = Target Then
c.Copy Destination:=Range(Target.Address)
Exit For
End If
Next
Application.EnableEvents = True
End Sub
これやっぱしアカンわ。複数のセルを選択したらエラーが出よるがな。 止めとこ。 この案引っ込めた（弥太郎）
早速試してみたんですけど(KAMIYA)さんの方法はせっかく丁寧にたくさん書いていただいているのですが・・・ごめんなさい、わたしが初心者なせいで理解し切れていないため実行できておりません。 せっかく考えていただいたのにと思うと自分が理解できない事が情けなく思います。
（弥太郎）さんの方法は書いてあるとおりにスクリプトをコピーしてみたら、どこを参照元にしていいかわからなかったのですが、勘で一番上の行かなと思い参照用の元データを並べてみたところ、できました！
どうやら一番上の行だけでなくても左上から右下への順番で検索がされていて、初めて出てきたデーターと同じデーターがその後に入ると最初に出てきたデーターのセルが丸ごとそこにコピーされる仕組みですね。
最初検索方向が〜というのの意味がわかりませんでしたがいじっていたらわかりました！ これものすごく便利だと思います！
ただ（弥太郎）さんも書いているとおり、複数のセルをコピーしてしまうとエラーになってしまうのが問題です。
複数のセルをコピーするような操作はしないのならこれで完璧と思いますが、残念ながらそういう操作を結構頻繁に行わなければならないシートにこの機能を盛り込みたいので、ん〜どうしたものか・・・
ところでこれは検索するエリアをあるひとつの四角いセルの集合体に設定することは可能ですか？
Sub Yata2()
'選択的書式コピー
v0 = InStr(1, Selection.Address, ",") v1 = Left(Selection.Address, v0 - 1) v2 = Mid(Selection.Address, v0 + 1, 1000)
For Each Cc In Range(v2)
For Each Cc2 In Range(v1)
If Cc.Value = Cc2.Value Then
Cc2.Select
Selection.Copy
Cc.Select
Selection.PasteSpecial Paste:=xlFormats
End If
Next
Next
End Sub
このシートは私以外の方も使うものなので説明が必要だったり特殊な操作をしなければならないものではないものが望ましいです。
そういう点で（弥太郎）さんのスクリプトがかなり私の理想に近いです。
元データ検索範囲の指定はFor Each c In Range("a:iv")というところをいじりましたらできました。
これを複数のセルを編集した際にもエラーが出ないようにすることはできないでしょうか？
複数のセルのデータを一度に削除しようとしただけでエラーになってしまったので。
このままでは使えないんですが、とても便利なだけになんとか・・・
わがままばかり言って申し訳ありません。 本当は自分でマクロ書けばいいのでしょうが勉強する時間がなくて。 興味はあるので時間があったら勉強します。
ほんなら「元祖すがやん」に挑戦ですわ。 このワークシートイベントは危険がつきまといますさかい、エンターキーでやってみま ひょか。 このマクロは完全に空欄で区切られた（コレ重要）集合体を検索してそれをコピーする ように組んであります。
yata3の実行でEnterキーを（必要項目入力の上）叩けばお望みの範囲をコピーでけます わ。End_Copyを実行するまでEnterキーが有効になってますさかい、そこんとこ気ぃつ けとっておくんなはれや。テンキーのEnterキーや↓キーでは反応しまへんさかい、検 索文字でもそのキーを利用すればコピーはせえしまへんでぇ。
あと、集合体でッけど、データが繋がってないと拾いまへんでぇ。 まあ、色々試してみておくんなはれ。 それから複数のセル問題もクリアしてま。 ほな...（弥太郎）
’標準モジュールにコピペ
Sub yata3()
Application.OnKey "~", "get_copy"
End Sub
'---------------
Sub get_copy()
Dim max_row As Long, max_col As Long
Dim grp_row As Integer, grp_col As Integer
max_row = ActiveSheet.UsedRange.Rows.Count
max_col = ActiveSheet.UsedRange.Columns.Count
For Each c In Range(Cells(1, 1), Cells(max_row, max_col))
If c = ActiveCell.Value Then
Set grp = Range(c.Address).CurrentRegion
grp_row = grp.Rows.Count
grp_col = grp.Columns.Count
grp.Copy Destination:=ActiveCell
Exit For
End If
Next
End Sub
'---------------------
Sub end_copy()
Application.OnKey "~"
End Sub
あとひとつ、集合体のどの文字にも反応します。
えぇ、一応そうなっとりまんねんけど、チョッと反応しすぎかも分かりまへんわ。
つまり、表のに記載してあるデータを迂闊に書くといきなり表が出現する事になります
さかい、もてあますかも知れまへんなぁ。ま、それは今晩ゆっくり考えまっさ。
明日仕事やし、わしゃもう風呂入って寝るで（弥太郎）
わたしの職場ではマクロをできる人がひとりもいなくて、一番エクセルを使える人がわたしで、それでもこんなレベルでして、標準の関数をちょこっと使える程度です。
わたしはエクセルわりかし好きなんですが、職場のひとたちはコピペすらめんどくさがるような人もいて、そのために少しずつ作った表のフォーマットが崩れて行ってしまうんです。 忙しいせいもあるんですがね。 そこでこういう機能が欲しくなったわけです。 マクロ使いこなせたらかっこいいですよねー 会社ではヒーローじゃないですか？
最近 ...ほな と、元気ないのかと思ったら頑張ってますね。 最初のマクロでエラーがでなければいいのなら、こんなかんじでどうでっしゃろ？ （おいぼぅれramrun）
最近ケンさんが私を打ち滅ぼそうとしているんです（笑）。 http://ryusendo.no-ip.com/cgi-bin/daken/type.cgi
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
For Each c In Cells
If c = Target Then
c.Copy Destination:=Range(Target.Address)
Exit For
End If
Next
Application.EnableEvents = True
End Sub
これ、数字の 0 が打てないようなので修正。
>これやっぱしアカンわ。 アカンコで済んだら警察要りません。 一度出したものを引っ込めるとは、真の漢とは呼べま千円。
>ほんなら「元祖すがやん」に挑戦ですわ。 下克上でっか？ ワクワク。
（ramrun）本日ハ晴天ナリ
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
For Each c In Cells
If c = Target.Text Then
c.Copy Destination:=Range(Target.Address)
Exit For
ElseIf c.Address = Target.Address Then
Exit For
End If
Next
Application.EnableEvents = True
End Sub
一つ前のコード「最近ケンさんが私を打ち滅ぼそうとしているんですバージョン」ですとエラーは毎回出ないんですが、元データの検索でヒットしないデータを入力するとエラーが出てしまいます。
一番最初のバージョンでは元データ検索エリアを指定できたのですが、 「最近ケンさんが私を打ち滅ぼそうとしているんですバージョン」 では検索エリアの指定はできませんか？
検索エリアを指定できればヒットしないデータの入力でエラーが出るのを回避できるかと思うのですが。 わたしの作りたいシートでは一番上の行に元データを並べています。
（まーちん）
>最近ケンさんが私を打ち滅ぼそうとしているんですバージョン あんまりそれ、連呼せんといてくれますか。 腹がよじれる（笑）。
しかし、ちょいまち。 最近ケンさんが私を打ち滅ぼそうとしているんですバージョンは、 If Target.Count > 1 Then Exit Sub を追加しただけで、そこでエラーがでているということかいな？ エラーは何て？
ちなみにセルが結合してあるとよろしくないけど。
（ramrun）弥っちゃんは遊びに行ってます
おいおい、勝手に決めたらあきまへんがな、（おいぼぅれramrun）はん。 危ないなぁ、チョッと仕事に精出しとったらこんな案配になりまっしゃろ〜、留守にで けへんわ、ホンマに。
まーちんさん、ほんなら > わたしの作りたいシートでは一番上の行に元データを並べ ています。を信用して（ホントはこれを早う言うて欲しかった）最初と同程度の精度 のマクロに変更しましたわ。 このブックを開いた途端にOnKeyがセットされますさかいな。ワークシートのチェンジ イベントと同じやと思うておくんなはれ。
話は変わって、早撃ちガンマン挑戦してきましたで。１回目は要領が分からんで残り
２０秒の表示で止まりましてんけど、２回目はライバルをコテンパンにやっつけました
で、えぇ。カンラ、カンラ。
'標準モジュールに
Sub auto_open()
yata4
End Sub
'-------------------
Sub yata4()
Application.OnKey "~", "get_copy"
Application.OnKey "{enter}", "get_copy"
Application.OnKey "{up}", "get_copy"
Application.OnKey "{down}", "get_copy"
Application.OnKey "{left}", "get_copy"
Application.OnKey "{right}", "get_copy"
End Sub
'-------------------
Sub end_copy()
Application.OnKey "~"
Application.OnKey "{enter}"
Application.OnKey "{up}"
Application.OnKey "{down}"
Application.OnKey "{left}"
Application.OnKey "{right}"
End Sub
'----------------------
Sub get_copy()
max_col = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To max_col
If Cells(1, i) = ActiveCell.Value Then
Cells(1, i).Copy Destination:=ActiveCell
Exit For
End If
Next i
ActiveCell.Offset(1, 0).Select
End Sub
2 65 590 591 592 593
私の作っているファイルでは一番上の行にこのようなデーターを並べていて
これらに書式をそれぞれ設定しています。
下のほうのセルに、ためしに640と入れたらこのエラーが出ました。
弥太郎さん
カンラ、カンラバージョン試してみましたところ、
矢印キーがどれを押してもカーソルが下のセルへ移動になってしまいます。
そしていくつか移動してしまいます。
そして関数使っていると書きましたが、
=CHOOSE(MATCH(L44,C1:M1,0),C2,D2,E2,F2,G2,H2,I2,J2,K2,L2,M2)
この関数が書いてあるセルで、しかも#N/Aになっているセルに移動するとエラーになってしまいます。 この関数が入っていても#N/Aではないところはエラーになりません。
今会社なんですが、今から帰りますので、次書き込めるのは夜になってしまいます。
よろしくお願いします。
（まーちん）
ほんならこれでどうでっか？ 矢印キーは分かってましたんやけど、やっぱし必要でっか。 >そしていくつか移動してしまいます ???コレはなんでやろ？ もう前のん捨ててこれでやってみておくんなはれ。 エライ長ったらしゅうなってもたんやけど、まぁまぁ実力通りのマクロですわ、えぇ。 おいぼぅれさんのに手ぇ加えた方が速いかも知れまへんけど、なんですわ、マクロは 裏方の仕事ですさかい、冗長でも何でも転けんと動いて望みの結果がでたらよろしおま っしゃろ、なぁまーちんさん。 ほなら...（弥太郎）
'-----------------
Dim keyno As Integer
'-----------------
Sub auto_open()
get_copy
End Sub
'-----------------
Sub end_copy()
Application.OnKey "~"
Application.OnKey "{enter}"
Application.OnKey "{up}"
Application.OnKey "{down}"
Application.OnKey "{left}"
Application.OnKey "{right}"
End Sub
'--------------------
Sub get_copy()
Dim max_col As Integer, i As Integer
max_col = Cells(1, Columns.Count).End(xlToLeft).Column
Application.OnKey "~", "enter"
Application.OnKey "{enter}", "enter"
Application.OnKey "{up}", "up"
Application.OnKey "{down}", "enter"
Application.OnKey "{left}", "left"
Application.OnKey "{right}", "right"
For i = 1 To max_col
If Not Application.IsError(Cells(1, i)) Then
If Cells(1, i) = ActiveCell.Value Then
Cells(1, i).Copy Destination:=ActiveCell
Exit For
End If
End If
Next i
Select Case keyno
Case 1
ActiveCell.Offset(-1, 0).Select
Case 2
ActiveCell.Offset(0, -1).Select
Case 3
ActiveCell.Offset(0, 1).Select
Case Else
ActiveCell.Offset(1, 0).Select
End Select
End Sub
'------------------
Sub up()
keyno = 1
get_copy
End Sub
'------------------
Sub left()
keyno = 2
get_copy
End Sub
'-------------------
Sub right()
keyno = 3
get_copy
End Sub
'--------------------
Sub enter()
keyno = 0
get_copy
End Sub
きゃん、きゃん。 ご主人が帰ってきた。 にしても、ライバルに大差をつけましたね、さすが弥っちゃん。
シートの中にエラーの数式があると確かにそうなりますね。 では、最近ケンさんが私を打ち滅ぼそうとしているんですバージョン３投下。 （ramrun）バレーがんがれ。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
For Each c In Cells
If IsError(Target) Then
Exit For
ElseIf Not IsError(c) Then
If c.Address = Target.Address Then
Exit For
ElseIf c = Target Then
If Not IsEmpty(c) Then
c.Copy Destination:=Range(Target.Address)
Exit For
End If
End If
End If
Next
Application.EnableEvents = True
End Sub
↑早速ダメで置き換え。 0値と空白、エラーの数式とか考えたらゴチャゴチャになってしまいました。 ちなみに結合セルはもうダメぽ。
goto errorのところ書き換えてます。またマカロニコードいうていちゃもんつけられそうですさかい。 もう時間がない ほな（弥太郎）
「実力通りのマクロですわバージョン」と「私を打ち滅ぼそうとしているんですバージョン３」両方とも試しました。 ありがとうございます。
「実力通りのマクロですわバージョン」は矢印キーの動きが解消されていますが関数の入っているところで#N/Aのところではエラーになります、ただしエラーになってもそのまま引き続き機能します。
そこで思ったのですが、私の用意している関数で#N/Aとなってしまうところはもともと
表示しない行として使う予定なので隠してみました。
ところが隠している行には通常矢印キーではセルにカーソルが行かないものですが、マクロの機能でしょうか？カーソルが行ってしまうためにエラーになってしまいます。
「私を打ち滅ぼそうとしているんですバージョン３」はエラーは今のところ出ませんが、なぜかデリートキーでデータ削除をすると０が入力されてしまいます。
そのほかに、たまにデリートでほかのセルに入っているデータを拾ってきたりもします。
しかし癖がありますが、なんとか０を表示しないオプションと、たまに拾ってくる現象がおきないようにセル配置を調整することでやりたいことができるようになりました。
本当にありがとうございます。 ついに実現しましたが引き続きデバッグしますので、また何かありましたらお願いしたいです。 よろしくおねがいします。 弥太郎さんの次のマカロニバージョンも見たいですし。
検証不足でしたね。失礼コキました。 もう0非表示オプションとセル配置のやりくりは必要ありません。
弥っちゃんの娘さん、速いぽ。 （ramrun）
私を打ち滅ぼそうとしているんですバージョン４
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
For Each c In Cells
If IsError(Target) Then
Exit For
ElseIf Not IsError(c) Then
If c.Address = Target.Address Then
Exit For
ElseIf c = Target Then
If Not IsEmpty(c) And Not IsEmpty(Target) Then
c.Copy Destination:=Range(Target.Address)
Exit For
End If
End If
End If
Next
Application.EnableEvents = True
End Sub
>弥っちゃんの娘さん、速いぽ。 まだ扶養家族のくせしてからに、ナマイキなんやあいつ。 それより、あとから！のハチマキ巻いたんがとんでもない得点挙げて行っきょりました なぁ。なんぼ努力してもあそこまではちょっと...。え〜い、シャクに障る。 どんじりに落ちん頼みの綱はケンさん一人。頼りにしてま。
まーちんさん、真打ちのワタシは明日でよろしいかな？ 明日１日退屈せんでもええと思うたら、ワクワクしますわ。今日はくたびれたからもう 寝ます。 ほな...（早寝早起き 弥太郎）
私も参加させてください。 他の方とメインの考え方は同じですが書式を個別にコピーする方法です。 ピントがずれていたらごめんなさい。 （kazu）
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sht As String, c As Long, c1 As Long, c2 As Long, r As Long
sht = "sheet1"
c1 = 1
c2 = 9
r = 1
If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then
Exit Sub
End If
For c = c1 To c2
If Sheets(sht).Cells(r, c).Value = Range(Target.Address).Value Then
Range(Target.Address).Font.FontStyle = _
Cells(r, c).Font.FontStyle ' 太字
Range(Target.Address).Font.ColorIndex = _
Cells(r, c).Font.ColorIndex ' 文字色
Exit For
End If
Next c
End Sub
kazuさん
ご参加ありがとうございます。
ごめんなさい、わたしは初心者なのでコードだけでは使い方がわかりません。
これは標準モジュールに追加でいいのでしょうか？
あと元データはどこにおけばいいでしょうか？
まーちんさん、おはようございます。 早速新規コードを下に掲載致します。 えっ、どっかで見たコードですって？ ほんなこと気ぃにせんとっておくれやす。
正直言いましてmr.ramrunのコードをケンショウしとったら、アホらしゅうて自分の コードいじる気ぃが起こってきまへんねん。 で、まぁ、元データが１行目にあるっちゅうことですさかい、検索範囲を狭めて１行目 以外の表示形式を拾わんように作り替えときましたんやけど、どうでっしゃろか。
それと、エラーの出とるセルを非表示にするお話、 =IF(ISERROR(CHOOSE(MATCH(L44,C1:M1,0),C2,D2,E2,F2,G2,H2,I2,J2,K2,L2,M2)),"",CHOOSE(MATCH(L44,C1:M1,0),C2,D2,E2,F2,G2,H2,I2,J2,K2,L2,M2)) ってな案配に空白セルで表示したらどうでっか？ いいえぇな、マクロを使う場合、やたら結合セルとか、非表示とか、列削除とかは、避 けた方が賢明ですわ。それを承知で組めたら問題おまへんけど...ナ。
>真打がやはりあるのですね 寄席を観に行ったら、前座でエライ盛り上がってもて、真打の落語はおもろい事もな〜 ともないっちゅう現象がしばしば起こりまんなぁ。 今回はその典型的な例でして、この度は前座の腕前の物スゴさをまざまざと見せつけら れましたわ、えぇ。
まぁ、そのうち真打も前座に太刀打ちでける程の腕前にならんと淡い期待をよせてまん
ねんけどナ。（ムリムリ）
おもろい事も何ともない（真打 弥太郎）
'-------------------
’私を打ち滅ぼそうとしているんですバージョン５
Private Sub Worksheet_Change(ByVal Target As Range)
Dim max_col As Integer
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
max_col = Cells(1, Columns.Count).End(xlToLeft).Column
For Each c In Range(Cells(1, 1), Cells(1, max_col))
If IsError(Target) Then
Exit For
ElseIf Not IsError(c) Then
If c.Address = Target.Address Then
Exit For
ElseIf c = Target Then
If Not IsEmpty(c) And Not IsEmpty(Target) Then
c.Copy Destination:=Range(Target.Address)
Exit For
End If
End If
End If
Next
Application.EnableEvents = True
End Sub
[kazu]です、すみません。説明不足でした。
[Alt]キーを押したまま[F11]キーを押して、VBEの世界に入ります。 もし[F11]キーがなければ、 [ツール(T)]メニュー→[マクロ(M)]→[Visal BasicEditor]で VBEの世界へ。
左側にプロジェクトVBAProjectと書かれたコーナーがあります。なければ [表示(V)]メニュー→[プロジェクトエクスプローラ(P)]を選択します。
プロジェクトエクスプローラの中に[ThisWorkBook]というアイコンが見えるはずです。 それをダブルクリックすると、右側にThisWorkbook(コード)が表示されます。 そこにVBAコードを貼り付けてください。
うまく貼り付けできたら、右上の×（閉じる）でVBEの世界からぬけます。
ワークシート側の元データはSheet1のA1からH1です。
（kazu）
kazuさんのコードを改造してみました。 参照元に書式を設定していないセルを残しておけば、Delキーで 書式も消えるので使い勝手がかなりいいように思います。 参照元も変更しやすいようにしました。 "Sheet1"とか"A1:I1"を変更すればいいです。 対応する書式はコード内のコメントのとおり。 ブック内の全シートに反映します。 （ramrun）パクってばかりですみませんヴァージョン１
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Rng As Object, Bas As Object
Set Bas = Worksheets("Sheet1").Range("A1:I1") ' 参照元
If Target.Count > 1 Then Exit Sub
For Each Rng In Bas
If Rng.Value = Target.Value Then
Target.NumberFormat = Rng.NumberFormat ' 数値表示形式
Target.Interior.ColorIndex = Rng.Interior.ColorIndex ' セルの色
Target.Font.ColorIndex = Rng.Font.ColorIndex ' 文字の色
Target.HorizontalAlignment = Rng.HorizontalAlignment ' 文字の横位置
Target.VerticalAlignment = Rng.VerticalAlignment ' 文字の縦位置
Exit For
End If
Next Rng
End Sub
実行時エラー '9':
インデックスが有効範囲にありません
と出ます。
ramrunさんのパクってばかりですみませんヴァージョン１
も同じエラーが出ます。
弥太郎さんの「私を打ち滅ぼそうとしているんですバージョン５」
すごいです、エラー完全に出ません。
それに
=IF(ISERROR(CHOOSE(MATCH(L44,C1:M1,0),C2,D2,E2,F2,G2,H2,I2,J2,K2,L2,M2)),"",CHOOSE(MATCH(L44,C1:M1,0),C2,D2,E2,F2,G2,H2,I2,J2,K2,L2,M2))
これすごくためになりました。 隠し行を使っていたのは#N/Aを見えなくするためにやっていたのですがそのために
=IF(ISERROR(L39),"",L39)
こういう式を使ったりしていました。
ほかに普通のデータが入っている行で隠したいところがあるので隠し行は使わなければなりません。
しかし、そういえばまだ言ってなかったのですが、結合セルは使っていません。
すみません、言うのがもっと早かったほうがよかったです。
みなさま本当にありがとうございました。 やりたかったことが完全に再現できています。 また何かあったらお願いしてもいいですか？
まーちんさん、他のお二人の名誉のためにも申し上げておきますが、まーちんさんが もうエラー処理のコードがご自分で記入でけるもんやと踏んでのコードですわ。 ほれに、アレは私のコードやおまへんねんで、えぇ。 賞賛のお言葉は、前座を務めた御方にお願いしま。
下のコードは原作kazu 脚色ramrun パクり屋弥太郎のコードです。kazuさんのコード にエラー処理と関数のコピーを単に付け加えただけの物です。 また、暇があったら廻してみておくんなはれ。旨い事いったら、今度はいま一人の前座 に拍手を贈っとっておくんなはれ。
>また何かあったらお願いしてもいいですか？
いつでもどうぞ
ほな...（パクり屋 弥太郎）
'---------------
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim n As Integer
Dim Rng As Object, Bas As Object
n = Cells(1, 256).End(xlToLeft).Column
Set Bas = Range(Cells(1, 1), Cells(1, n))
If Target.Count > 1 Then Exit Sub
For Each Rng In Bas
If IsError(Target) Then
Exit For
ElseIf Not IsError(Rng) Then
If Rng.Address = Target.Address Then
Exit For
ElseIf Rng = Target Then
If Left(Rng.Formula, 1) = "=" Then
Range(Rng.Address).Copy Destination:=Range(Target.Address)
' Range(Target.Address) = Rng.Formula '拾った式を＄立てで書き込む
End If
Target.NumberFormat = Rng.NumberFormat ' 数値表示形式
Target.Interior.ColorIndex = Rng.Interior.ColorIndex ' セルの色
Target.Font.ColorIndex = Rng.Font.ColorIndex ' 文字の色
Target.HorizontalAlignment = Rng.HorizontalAlignment ' 文字の横位置
Target.VerticalAlignment = Rng.VerticalAlignment ' 文字の縦位置
Target.Font.FontStyle = Rng.Font.FontStyle ' 文字の太さ
Exit For
End If
End If
Next Rng
End Sub
皆様、最後のコードを試して見ましたところこれも完璧に動いています。
皆さんのコードを足して作られているわけですから、せっかくですからこちらをつかわさせていただこうと思います。
皆様本当にありがとうございました。 それで完成したばかりなんですが、新しいコードをお願いしたいものができてしまったのです。
新しいスレッド立てますので、ぜひお時間がありましたら覗いてやってみてください。
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.