- ベストアンサー
ユーザー定義関数で書式ごとコピーする方法を考える
real beatin(@realbeatin)の回答
- real beatin(@realbeatin)
- ベストアンサー率82% (174/211)
' ' === 以下、標準モジュール === ReW9087799 Option Explicit ' ' /// セル範囲またはセル参照文字列を引数にして、参照元の値を返すだけの単純なUDF ' ' /// 再計算確定後にThisWorkbookモジュール側で参照元の書式をコピーする為の呼び出し〓が1行 Public Function GetTxt(ByVal vRef As Variant) Application.Volatile False With Application.ThisCell On Error GoTo ErrRef_ If TypeName(vRef) = "String" Then If InStr(vRef, "!") Or ActiveSheet Is .Worksheet Then Set vRef = Range(vRef) Else Set vRef = Range("'" & .Worksheet.Name & "'!" & vRef) End If End If GetTxt = vRef.Value On Error GoTo 0 Call_Out_: Call ThisWorkbook.SetSrcDst(rSrc:=vRef, rDst:=.Cells) ' 〓 End With Exit Function ErrRef_: Set vRef = Nothing GetTxt = CVErr(xlErrRef) Resume Call_Out_ End Function ' ' === 以上、標準モジュール === ' ' === 以下、ThisWorkbookモジュール === ReW9087799 ' ' /// 宣言部 Option Explicit Private WithEvents appThisXl As Application Private colSrcDst As New Collection ' ' /// イベント このブックが開かれたタイミングでApplicationのイベントを活性化 Private Sub Workbook_Open() Set appThisXl = Application End Sub ' ' /// イベント Excel.Application の ひとつのセル操作契機に因る一連の再計算すべて が 確定したタイミング ' ' /// Collectionオブジェクトに記録した転写元・転写先間で書式のコピーを実行 Private Sub appThisXl_AfterCalculate() Dim col As Collection Dim vAry If colSrcDst.Count = 0 Then Exit Sub With Application .ScreenUpdating = False .EnableEvents = False End With For Each col In colSrcDst Call RangesToAreas(col) For Each vAry In col Call TranscrFormats(vAry) Next Next Set colSrcDst = New Collection With Application .EnableEvents = True .ScreenUpdating = True End With End Sub ' ' /// 書式転写元/先が同じもの単位で、バラバラのセルをひとつのセル領域に纏める ' ' /// 呼び出し元:ThiswWorkbook/Sub appThisXl_AfterCalculate Private Sub RangesToAreas(ByRef col As Collection) Dim vAry Dim sRefPtn As String Dim i As Long For i = col.Count To 1 Step -1 vAry = col(i) If vAry(0) Is Nothing Then sRefPtn = "ErrRef" If vAry(1).HasArray Then Set vAry(1) = vAry(1).CurrentArray On Error Resume Next If Not IsArray(col(sRefPtn)) Then Else Set vAry(1) = Application.Union(col(sRefPtn)(1), vAry(1)) col.Remove sRefPtn End If Else sRefPtn = vAry(0).Worksheet.Name & "!" sRefPtn = sRefPtn & Application.ConvertFormula(vAry(0).Address(0, 0), xlA1, xlR1C1, xlRelative, Range(vAry(1).Address(0, 0))) If vAry(1).HasArray Then Set vAry(1) = vAry(1).CurrentArray ElseIf vAry(0).Count > 1 Then Set vAry(0) = vAry(0)(1) End If On Error Resume Next If Not IsArray(col(sRefPtn)) Then Else Set vAry(0) = Application.Union(col(sRefPtn)(0), vAry(0)) Set vAry(1) = Application.Union(col(sRefPtn)(1), vAry(1)) col.Remove sRefPtn End If End If On Error GoTo 0 col.Add Item:=vAry, Key:=sRefPtn, After:=i col.Remove i Next i End Sub ' ' /// 書式転写 ' ' /// 呼び出し元:ThiswWorkbook/Sub appThisXl_AfterCalculate Private Sub TranscrFormats(ByVal vAry As Variant) Dim i As Long If vAry(0) Is Nothing Then vAry(1).ClearFormats Else For i = 1 To vAry(1).Areas.Count vAry(0).Areas(i).Copy vAry(1).Areas(i).PasteSpecial Paste:=xlPasteFormats Next i Application.CutCopyMode = 0 End If End Sub ' ' /// 書式転写[元/先] を 書式転写先シート単位で Collectionオブジェクトに格納(記録) ' ' /// 呼び出し元:Module1/Function GetTxt Public Sub SetSrcDst(ByVal rSrc As Range, ByVal rDst As Range) Dim sWksDst As String If appThisXl Is Nothing Then Set appThisXl = Application If Not rSrc Is Nothing Then With rSrc.Worksheet sWksDst = .Parent.Name & "$" & .Name End With End If With rDst.Worksheet sWksDst = sWksDst & "->" & .Parent.Name & "$" & .Name End With On Error Resume Next If Not IsObject(colSrcDst(sWksDst)) Then colSrcDst.Add Item:=New Collection, Key:=sWksDst End If On Error GoTo 0 colSrcDst(sWksDst).Add Item:=VBA.Array(rSrc, rDst), Key:=rDst.Address(0, 0) End Sub ' ' === 以上、ThisWorkbookモジュール ===
関連するQ&A
- エクセルVBA MATCHをユーザー定義関数で使う
ユーザー定義関数の質問です。 ある値をB列で探し、見つけたセルの行番号を取得したいのですが分かりません。 条件が一つあってそれはAの値が10以下のものは検索から除外するということです。 例 A B 6 50 5 45 7 2 12 45 11 9 例えばBが45かつAの値が10以上であるセルの行番号はこの例だと4になります。 ワークシート関数を使うと{=MATCH(45,(A1:A5>=10)*(B1:B5),0)}でできました。しかしユーザー定義関数で.Match(45, Worksheets("Sheet1").Range("A1:A5>=10") * Worksheets("Sheet1").Range("B1:B5"), 0)とやっても#VALUE!となってしまいました。何がおかしいのでしょうか。
- ベストアンサー
- Visual Basic
- ユーザー定義関数でシート名を取得したい
例えば、以下のユーザー定義関数で Public Function Test(A As Range) Test=A.Address End Function AにアクティブシートのセルA1~セルB2を指定すると「$A$1:$B$2」という値が帰ってきますが、 別のシートのセルA1~セルB2を指定しても、「$A$1:$B$2」という値が帰ってきます。 シート名が抜けてしまっているのですが、シート名はどのようにしたら取得できますか?
- ベストアンサー
- Excel(エクセル)
- 条件付き書式のコピーについて
シート1のセルとシート2のセルが一致しない場合、書式の変化が発動するように設定しようとしています。 現在、シート1のセルA1の書式設定に、 「次の値に等しくない」 「=INDIRECT("Sheet2!$A1")」 と入力されています。 この時点でシート1のA1は正常に書式が発動されました。 そこでシート1のA列すべてに書式をコピーしたいのですが、コピーをするとすべてのセルの書式が「=INDIRECT("Sheet2!$A1")」となってしまいます。 「=INDIRECT("Sheet2!$A1")」 「=INDIRECT("Sheet2!$A2")」 「=INDIRECT("Sheet2!$A3")」・・・・ となってもらいたいのですが。 コピー方法はセルA1の書式設定したあと、マウスの右ドラックをして「書式のみコピー」を選択して実行しました。 どこか間違っていますでしょうか。
- ベストアンサー
- その他MS Office製品
- ユーザー定義の書式設定を文字列データで取得
他の方が作ったエクセルのワークシートのセルにユーザー定義で書式設定されています。 たとえば、 "AKB-"0000 "SKE-"0000 とか、いろいろあります。 数値で48と入力すれば、AKB-0048やSKE-0048 のように表示されます。 なんでこんなのを書式設定でするんだ!というお叱りはひとまずおいといてください。 この表示された状態を、他のセルに文字列としてAKB-0048やSKE-0048 というデータとして簡単に取得する方法はないでしょうか? 最初、 ="AKB-"&TEXT(A5,"0000") で簡単・・・なんて思ったのですが、ユーザー定義が何種類もあり、一度ではできず結構手間です。 VBAならば Sub test() Dim c As Range For Each c In Selection c.Offset(, 1).Value = c.Text Next End Sub でできるのですがVBA抜きのワークシートの操作でできるかどうかの質問です。 ユーザー定義関数もVBAなので除外させてください。 よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- エクセル Excel 関数or条件付き書式
あけましておめでとうございます(*^_^*) 新年早々教えてください! セルに指定された値(文字列)を入力すれば 自動で別のシートの別のセルの書式が変更される (あるいは関数により自動で値が入力される) 方法を探しています! エクセルマスターの方お願いします! 【具体的に…】 シート1の セルA1に 指定された文字列(例-ねずみ)を 入力すれば ↓ シート2の セルC10の 書式が 自動変更される(例-フォントが赤になる) もしくは 【具体的に…(2)】 シート1の セルA1に 指定された文字列(例-ねずみ)を 入力すれば ↓ シート2の セルC10に 指定された値(例-厄年)が 自動入力される そんな方法を教えてください! どちらもできれば最高です!!
- ベストアンサー
- オフィス系ソフト
- セルを参照する マクロ? 条件書式?
セルを参照するマクロまたは条件書式について教えてください。 シートAのセルA1に、ひらがなの【あ】という文字が入力された時 B1セルに入力できる値をシートBのE2からH2を参照 シートAのセルA1に、ひらがなの【い】という文字が入力された時 B1セルに入力できる値をシートBのE3からH3を参照 というのは値のみなら、関数で行えると思いますが 添付画像のようにセルに塗りつぶしがされている際 この塗りつぶしも反映させたいと考えております。 ネットには条件書式でやればという情報はいくつかでていますが あ、い、う にそれぞれ同じ値があるとそれはできないかと思います。 調べたところ、入力規制のリストでは不可能なようなので A1セルに【あ】と入力されていて尚且つB1セルに1と入力されたら オレンジに、2と入力されたら青に・・・ A1セルに【い】と入力されていて尚且つB1セルに1と入力されたら 青に、2と入力されたらオレンジに・・・ のような感じでもよいと考えています。 もちろん指定した範囲内にない文字の場合(例えばB1セルに5を入力)は 塗りつぶしは起こらないでいいです。 マクロなのか条件書式なのかはわからないのですが 上記のようなことができるか教えてください。 ちなみに画像では説明の為 1つのシート内に書いてありますが 実際はシートAとBの2つがあります。 宜しくお願いします。
- ベストアンサー
- Excel(エクセル)
- Excelでのセルの書式設定で、ユーザー定義が反映されない。
Excelでのセルの書式設定で、ユーザー定義が反映されない。 別シートから参照した数値(@)が入力されると「○○○@○」と表示させたいのですが・・・ たとえばですが、 Sheet1のA1セルに「=IF(Sheet2!A1="","",Sheet2!A1)」という数式を入れてあります。 Sheet1のA1セルの「セルの書式設定」を「ユーザー定義」にして、「"花""子""は"@"歳"」にしてあります。 これでSheet2のA1セルに「3」と入力します。 Sheet1のA1セルに「花子は3歳」と表示されると思っていたのですが、「3」しか表示されません。 何が間違っているのかわかりません。 お知恵を拝借させてください。m(__)m
- ベストアンサー
- その他MS Office製品
- ユーザ定義関数がうまく動きません。
ユーザ定義関数がうまく動きません。 2月のA1セル値が1になっていたりします。 どこがおかしいのかわかりません。解決方法を教えていただけませんでしょうか。 よろしくお願いします。 【シートの設定】 シート名は1月・・・12月です。 各シートの A1セルは「=sheetname()」 B1セルは「月のチェックシート」 が入っています。 【VBAの設定】 Function SheetName() As String 'Application.Volatile If Len(ActiveSheet.Name) = 3 Then SheetName = Left(ActiveSheet.Name, 2) Else SheetName = Left(ActiveSheet.Name, 1) End If End Function
- ベストアンサー
- オフィス系ソフト
- 条件付き書式4つ以上のVBAについて
初心者なので基本的なことをお聞きするかもしれません。 エクセルのVBAを使って4つ以上の条件付き書式を設定したいと思いネットでいろいろと調べて設定しました。しかし,実際に他のワークシートから値をコピーして貼り付けても書式が変わりません。実際にセルに値を入力するときちんと書式が変わるのですが,コピー貼り付けではだめなのでしょうか?何かよい方法があれば教えてください。
- 締切済み
- Visual Basic
- エクセル関数について
エクセルの関数についてなのですが、例えば「セルA3」に「セルB2」の値を表示させるには「=(B2)」と「セルA3」に表示させてます。別のSheetの値も表示できるのでしょうか?例えば「Sheet1.Range("A3")」の値をSheet2のA1に表示させたい場合Sheet2のA1にはどのような関数を入力していけばよいのでしょうか?VBAは使わずに表示したいのですが。関数はまだほとんど使ったことがないので分かる人いたら教えてください。よろしくお願いします。
- ベストアンサー
- オフィス系ソフト