Results of 1 - 1 of about 33544 for 関数 (0.006 sec.)
- [[20230301183714]]
- #score: 2646
- @digest: 20a1fb842fcd82050cfdb01b93b7f595
- @id: 93644
- @mdate: 2023-03-03T01:49:13Z
- @size: 15644
- @type: text/plain
- #keywords: overlapcheck (232845), checkcolumn (223151), explain (165772), resultws (164626), pastearr (138397), overlapok (130826), targetcells (102184), asht (84437), nextloop (59986), errhandl (53066), cznc2hu00t (38104), 数一 (31583), resultwscheck (29523), inarr (28639), マサ (15584), xlcelltypeformulas (11095), 間4 (8293), byref (6479), prompt (5893), rng (4818), 一覧 (4120), item (3980), address (3796), formula (3563), displayalerts (3475), error (2833), specialcells (2765), clear (2740), inputbox (2705), worksheet (2395), activate (2368), goto (2328)
- 『記入関数を一覧表のように表示する』（マサイ）
シート内に記入した全ての関数式を別シートに どこのセルで どんな関数式が使われたか 一覧表示する方法（VBA)はありますか? 例えば、sheet1が下記の場合 |[A] |[B] |[C] [2]| 123456|=LEN(A2)| [3]| 789|=LEN(A3)| [4]| 2562|=LEN(A4)| [5]|=SUM(A2:A4)| | sheet2に以下のように書き出す |[A]|[B] [1]|B2 |=LEN(A2) [2]|B3 |=LEN(A3) [3]|B4 |=LEN(A4) [4]|A5 |=SUM(A2:A4) 書き出す型式は、他に分かりやす型式があれば 上記にはこだわりはありません。 ＜ 使用 Excel:Microsoft365、使用 OS:Windows11 ＞ ---- Sub test() Dim ws1 As Worksheet, ws2 As Worksheet Dim rng As Range, i As Long Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") For Each rng In ws1.Range("A1").CurrentRegion If rng.HasFormula Then i = i + 1 ws2.Cells(i, "A") = rng.Address(0, 0) ws2.Cells(i, "B") = "'" & rng.Formula End If Next End Sub （フォーキー） 2023/03/01(水) 19:00:41 ---- フォーキーさん、コードありがとうございます。 CurrentRegionでA1の塊を候補にしていますが 他にも塊でない場所にも関数を書いたセルがあります。 アクティブシート内の使用中の全てのセルを対象にしたいので 以下を考えましたがエラーは出ませんが上手くいきません。 どう変更すれば良いですか? Sub 関数一覧() Dim ws2 As Worksheet Dim i As Long Set ws2 = Worksheets("Sheet2") With ActiveSheet.UsedRange If .HasFormula Then i = i + 1 ws2.Cells(i, "A") = rng.Address(0, 0) ws2.Cells(i, "B") = "'" & rng.Formula End If End With End Sub （マサイ） 2023/03/02(木) 08:10:26 ---- 思いつきで試したら上手く処理されました。 Option Explicit Sub 関数一覧() Dim ws2 As Worksheet, Asht As Worksheet Dim rng As Range, i As Long Set ws2 = Worksheets("Sheet2") Set Asht = ActiveSheet For Each rng In Asht.UsedRange If rng.HasFormula Then i = i + 1 ws2.Cells(i, "A") = rng.Address(0, 0) ws2.Cells(i, "B") = "'" & rng.Formula End If Next End Sub できたらB列のセルがどんな数式なのかを説明したセルが周囲にあるのですが これをC列に書き込みたいと思いますが何か方法がありますか? 例えば k12 : 時間4 |[A]|[L] |[C] [12] |K7 |=HOUR(J5) |時間4 問題なのは、説明したセルが数式の周囲にあるので 以下の場合では、8つの内どれを指定するかを手動で選択すると言うことです。 （上の場合は、左側の「時間4」を選択） |[K] |[L] |[M] [11]|時間1|時間2 |時間3 [12]|時間4|=HOUR(J5)|時間5 [13]|時間6|時間7 |時間8 （マサイ） 2023/03/02(木) 08:39:03 ---- γさん、アドバイス感謝します。 CtrlとShiftキーを押しながら@キーで式モードになる。 なるほど便利な機能ですね。 式モードは、それはそれで便利なのですが やはり一覧表は、捨てがたいです。 08:10:26で提案した一覧表（説明付き）を完成させたいと思います。 何か、方法があればお願いします。 （マサイ） 2023/03/02(木) 08:48:44 ---- Sub 関数一覧() Dim Asht As Worksheet, Resultws As Worksheet Dim rng As Range, i As Long Dim TargetCells As Long Set Asht = ActiveSheet Set Resultws = ThisWorkbook.Worksheets("Sheet2") On Error GoTo ErrHandl TargetCells = Asht.Cells.SpecialCells(xlCellTypeFormulas, 23).Count On Error GoTo 0 Resultws.Range("A1").CurrentRegion.Clear Application.DisplayAlerts = False On Error GoTo nextloop ReDim PasteArr(1 To TargetCells, 1 To 3) For Each rng In Asht.Cells.SpecialCells(xlCellTypeFormulas, 23) i = i + 1 PasteArr(i, 1) = rng.Address(0, 0) PasteArr(i, 2) = "'" & rng.Formula Asht.Activate rng.Select PasteArr(i, 3) = Application.InputBox(prompt:=rng.Address(0, 0) & "の説明を選択してください", Type:=8).Value nextloop: Err.Clear Next On Error GoTo 0 Application.DisplayAlerts = True Resultws.Range("A1", Resultws.Cells(TargetCells, 3)) = PasteArr Exit Sub ErrHandl: MsgBox ("数式は見つかりませんでした。") Err.Clear End Sub （cZnc2hu00T） 2023/03/02(木) 10:58:12 ---- cZnc2hu00Tさん、参加いただきありがとうございます。 早速コードを試してみました。 思い描いていた手順で説明が設定できるので何点かは除いて完璧です。 試用したシートに結合セルがあるので何箇所か B列が空欄のセルができました。 これは、後でB列が空欄のセルは、行を削除すれば問題ないと思います。 構想が甘く月ごとの集計のようなシート構成では、 同じ列に縦長に日付が日数分ある場合、計算式も同じ数だけ配置される場合は何度も同じ説明を選択する事です。 そこでVBAで行が更新されて同じ列が出た場合に、 例えば「F列は、2度めですが同じ説明ですか?」と聞くようにして 「Y」でF列の説明を最初の説明と同じとして以後問い合わせをしないようにコードを変更したいのですができますか ? （マサイ） 2023/03/02(木) 12:29:20 ---- Sub 関数一覧() Dim Overlapcheck As Object Dim OverlapOK As Object Set Overlapcheck = CreateObject("Scripting.Dictionary") Set OverlapOK = CreateObject("Scripting.Dictionary") Dim Asht As Worksheet, Resultws As Worksheet Dim rng As Range, i As Long Dim TargetCells As Long Set Asht = ActiveSheet Set Resultws = ThisWorkbook.Worksheets("Result") On Error GoTo ErrHandl TargetCells = Asht.Cells.SpecialCells(xlCellTypeFormulas, 23).Count On Error GoTo 0 Resultws.Range("A1").CurrentRegion.Clear Application.DisplayAlerts = False ReDim PasteArr(1 To TargetCells, 1 To 3) For Each rng In Asht.Cells.SpecialCells(xlCellTypeFormulas, 23) If (rng.Formula <> "") Then i = i + 1 PasteArr(i, 1) = rng.Address(0, 0) PasteArr(i, 2) = "'" & rng.Formula PasteArr(i, 3) = Explain(Overlapcheck, OverlapOK, Asht, rng) End If Next On Error GoTo 0 Application.DisplayAlerts = True Resultws.Range("A1", Resultws.Cells(TargetCells, 3)) = PasteArr Exit Sub ErrHandl: MsgBox ("数式は見つかりませんでした。") Err.Clear End Sub Function Explain(ByRef Overlapcheck As Object, ByRef OverlapOK As Object, ByRef Asht As Worksheet, ByRef rng As Range) As String Dim CheckColumn CheckColumn = Split(rng.Address, "$")(1) On Error GoTo nextloop If Overlapcheck.exists(CheckColumn) Then If (OverlapOK.exists(CheckColumn)) Then Explain = Overlapcheck.Item(CheckColumn) Else If (MsgBox(CheckColumn & "列は前に" & Overlapcheck.Item(CheckColumn) & _ "と入力されていますが、以降同じ説明ですか?", vbYesNo) = vbYes) Then OverlapOK.Add Item:=True, Key:=CheckColumn Explain = Overlapcheck.Item(CheckColumn) Else Asht.Activate rng.Select Explain = Application.InputBox(prompt:=rng.Address(0, 0) & "の説明を選択してください", Type:=8).Value Overlapcheck.Remove CheckColumn Overlapcheck.Add Item:=Explain, Key:=CheckColumn End If End If Else Asht.Activate rng.Select Explain = Application.InputBox(prompt:=rng.Address(0, 0) & "の説明を選択してください", Type:=8).Value Overlapcheck.Add Item:=Explain, Key:=CheckColumn End If On Error GoTo 0 Exit Function nextloop: Err.Clear End Function （cZnc2hu00T） 2023/03/02(木) 14:06:58 ---- 同じ説明を加味した修正コードありがとうございます。 結合セルの処理も追加いただきバッチリ結果がでるようになりました。 大満足で結果を書き出すシートを「関数一覧」として 「関数一覧」シートの有無でシートを作成するか/しないかを判断するコードを追加しましたが どうもActiveSheetを設定するコードに不備があるようで上手く書き出されません。 又、途中で以下のコードで「インデックスが有効範囲にありません。」のエラーがでました。 PasteArr(i, 1) = rng.Address(0, 0) すいませんが、コードを見ていただけませんか? Option Explicit Sub 関数一覧3() Dim Overlapcheck As Object Dim OverlapOK As Object Set Overlapcheck = CreateObject("Scripting.Dictionary") Set OverlapOK = CreateObject("Scripting.Dictionary") Dim Asht As Worksheet, Resultws As Worksheet, temp As Worksheet Dim rng As Range, i As Long Dim TargetCells As Long Dim flg As Long Set Asht = ActiveSheet '関数一覧シートの存在チェック For i = 1 To Sheets.Count If Sheets(i).Name = "関数一覧" Then flg = 1 End If Next If flg <> 1 Then Set temp = Sheets.Add(after:=Sheets(Sheets.Count)) temp.Name = "関数一覧" End If Asht.Activate Set Resultws = Worksheets("関数一覧") On Error GoTo ErrHandl 'データの種別が数式、文字、論理値、エラー値であるセルをカウント TargetCells = Asht.Cells.SpecialCells(xlCellTypeFormulas, 23).Count On Error GoTo 0 '書き出しシート初期化（クリアー） Resultws.Range("A1").CurrentRegion.Clear Application.DisplayAlerts = False ReDim PasteArr(1 To TargetCells, 1 To 3) For Each rng In Asht.Cells.SpecialCells(xlCellTypeFormulas, 23) If (rng.Formula <> "") Then i = i + 1 PasteArr(i, 1) = rng.Address(0, 0) PasteArr(i, 2) = "'" & rng.Formula '独自関数(説明記入) PasteArr(i, 3) = Explain(Overlapcheck, OverlapOK, Asht, rng) End If Next On Error GoTo 0 'エラー処理を無効にする Application.DisplayAlerts = True Resultws.Range("A1", Resultws.Cells(TargetCells, 3)) = PasteArr Exit Sub ErrHandl: MsgBox ("数式は見つかりませんでした。") Err.Clear End Sub Function Explain(ByRef Overlapcheck As Object, ByRef OverlapOK As Object, ByRef Asht As Worksheet, ByRef rng As Range) As String Dim CheckColumn CheckColumn = Split(rng.Address, "$")(1) On Error GoTo nextloop If Overlapcheck.exists(CheckColumn) Then If (OverlapOK.exists(CheckColumn)) Then Explain = Overlapcheck.Item(CheckColumn) Else If (MsgBox(CheckColumn & "列は前に" & Overlapcheck.Item(CheckColumn) & _ "と入力されていますが、以降同じ説明で良いですか ?", vbYesNo) = vbYes) Then OverlapOK.Add Item:=True, Key:=CheckColumn Explain = Overlapcheck.Item(CheckColumn) Else Asht.Activate rng.Select Explain = Application.InputBox(prompt:=rng.Address(0, 0) & "の説明を選択してください。", Type:=8).Value Overlapcheck.Remove CheckColumn Overlapcheck.Add Item:=Explain, Key:=CheckColumn End If End If Else Asht.Activate rng.Select Explain = Application.InputBox(prompt:=rng.Address(0, 0) & "の説明を選択してください。", Type:=8).Value Overlapcheck.Add Item:=Explain, Key:=CheckColumn End If On Error GoTo 0 Exit Function nextloop: Err.Clear End Function （マサイ） 2023/03/02(木) 17:21:15 ---- 変更点 変数tempの役割がResultwsと被っていたため統合(最後にResultwsに書き出しているのでどのみち正常に動かないです) 変数flgの名前をわかりやすく変更 変数iが二ヶ所で使われてしまっていたため片方の名前を変更(これが"インデックスが有効範囲にありません。"というエラーが出た原因) Sub 関数一覧3() Dim Overlapcheck As Object Dim OverlapOK As Object Set Overlapcheck = CreateObject("Scripting.Dictionary") Set OverlapOK = CreateObject("Scripting.Dictionary") Dim Asht As Worksheet, Resultws As Worksheet Dim rng As Range, i As Long, inArr As Long Dim ResultwsCheck As Boolean Dim TargetCells As Long Set Asht = ActiveSheet '関数一覧シートの存在チェック ResultwsCheck = False For i = 1 To Sheets.Count If Sheets(i).Name = "関数一覧" Then ResultwsCheck = True Set Resultws = Worksheets("関数一覧") End If Next If Not ResultwsCheck Then Set Resultws = Sheets.Add(after:=Sheets(Sheets.Count)) Resultws.Name = "関数一覧" End If Asht.Activate On Error GoTo ErrHandl 'データの種別が数式、文字、論理値、エラー値であるセルをカウント TargetCells = Asht.Cells.SpecialCells(xlCellTypeFormulas, 23).Count On Error GoTo 0 '書き出しシート初期化（クリアー） Resultws.Range("A1").CurrentRegion.Clear Application.DisplayAlerts = False ReDim PasteArr(1 To TargetCells, 1 To 3) For Each rng In Asht.Cells.SpecialCells(xlCellTypeFormulas, 23) If (rng.Formula <> "") Then inArr = inArr + 1 PasteArr(inArr, 1) = rng.Address(0, 0) PasteArr(inArr, 2) = "'" & rng.Formula '独自関数(説明記入) PasteArr(inArr, 3) = Explain(Overlapcheck, OverlapOK, Asht, rng) End If Next On Error GoTo 0 'エラー処理を無効にする Application.DisplayAlerts = True Resultws.Range("A1", Resultws.Cells(TargetCells, 3)) = PasteArr Exit Sub ErrHandl: MsgBox ("数式は見つかりませんでした。") Err.Clear End Sub Function Explain(ByRef Overlapcheck As Object, ByRef OverlapOK As Object, ByRef Asht As Worksheet, ByRef rng As Range) As String Dim CheckColumn CheckColumn = Split(rng.Address, "$")(1) On Error GoTo nextloop If Overlapcheck.exists(CheckColumn) Then If (OverlapOK.exists(CheckColumn)) Then Explain = Overlapcheck.Item(CheckColumn) Else If (MsgBox(CheckColumn & "列は前に" & Overlapcheck.Item(CheckColumn) & _ "と入力されていますが、以降同じ説明で良いですか ?", vbYesNo) = vbYes) Then OverlapOK.Add Item:=True, Key:=CheckColumn Explain = Overlapcheck.Item(CheckColumn) Else Asht.Activate rng.Select Explain = Application.InputBox(prompt:=rng.Address(0, 0) & "の説明を選択してください。", Type:=8).Value Overlapcheck.Remove CheckColumn Overlapcheck.Add Item:=Explain, Key:=CheckColumn End If End If Else Asht.Activate rng.Select Explain = Application.InputBox(prompt:=rng.Address(0, 0) & "の説明を選択してください。", Type:=8).Value Overlapcheck.Add Item:=Explain, Key:=CheckColumn End If On Error GoTo 0 Exit Function nextloop: Err.Clear End Function （cZnc2hu00T） 2023/03/03(金) 08:24:06 ---- cZnc2hu00Tさん、昨日に続きコードの修正ありがとうございます。 エラー「インデックスが有効範囲にありません。」についてですが シートの構成を少しずつ替えて数パターンでマクロを試してみた結果 エラーが出るのは、同じ列で既に説明を記入したセルがあって更に 同列で途中に何も記入されていない空白のセルがあるに場合に発生していました。 昨日から変数(i)の使い回しが原因とは、思いもよらず 全く違うところに着目して泥沼に入り込んで悪戦苦闘していました。 まだ、数パターンしか試していませんが教えてもらったコードで上手く処理されています。 アドバイス感謝いたします。 （マサイ） 2023/03/03(金) 10:18:04 ---- 最後に下記処理を追加してこれで一応完成と思います。 関数一覧.Range("A1").CurrentRegion.Sort key1:=関数一覧.Range("A1"), Order1:=xlAscending （マサイ） 2023/03/03(金) 10:49:13... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202303/20230301183714.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97062 documents and 608326 words.
訪問者：