- ベストアンサー
エクセル・マクロについて
pauNedの回答
- pauNed
- ベストアンサー率74% (129/173)
（#7補足へのレスです） まず、簡単な例で実験実験^ ^ 1)新規シートのシートモジュールに以下コピーペースト。 Private Sub Worksheet_Change(ByVal Target As Range) MsgBox "Change" End Sub 2)そのシートのA1セルに 1 と入力。（どこでも構わないンですが） 3)A1セルの 1 をクリアしてみる。 4)A1セルに 1 と入力してみる。 5)A1セルにもう一度 1 と入力してみる。 どうですか？ Worksheet_Changeイベントはセルの値そのものを変更させる時に動くイベントです。 6)同じシートに別シート参照の数式を入れてみる。例えば B1 セルに =Sheet2!A1 （数式の入力時にはWorksheet_Changeイベントが動きます） 7)次にSheet2のA1に 1 と入れてみる。 どうでしょう？ 数式を入れたセルに『表示された値』は変化していますが Worksheet_Changeイベントは動きません。 セルに『入力された値（つまり数式）』は変化していないからです。 8)同じシートのシートモジュールに今度は以下コピーペースト。 Private Sub Worksheet_Calculate() MsgBox "Calculate" End Sub 9)さきほどの参照先Sheet2のA1セルをクリアしてみる。 10)同じくSheet2のA1に 1 と入れてみる。 どうでしょう？ Worksheet_Changeイベントはシートに数式があり、再計算される時に動くイベントです。 kozou1126さんの状況で言うと、 B列RSSの『表示結果』や、A列の判定数式の『表示結果』が変わっただけでは Worksheet_Changeイベントは動かないという事です。 そのため、Worksheet_Calculateイベントに変更し、 シートが再計算される度に Range("A1:A100").Find(What:="TRUE", LookIn:=xlValues) この部分でA列の表示結果を検索して、 TRUE 表示されたセルがあった場合のみ処理を行うように変更してみました。
関連するQ&A
- エクセルマクロで定義した関数が動きません
以前にマクロの記述について教えて頂いた件の続きになります． ご指導頂いたとおりExcelマクロで複素数を扱う関数を下記HPから 標準モジュールにコピペしました．今度は正しくコピーできたと思いますが， 実行するとエラーになります． 標準の組込み関数を用いて「実数」の行列を計算すれば正しく 計算できますが，当然ながら「複素数」は計算できません． この「複素数」を扱う新しく定義した関数が動かない理由， 「End if に対するifブロックがありません」とか 計算結果が「#VALUE!」となってしまうのは何故でしょうか？ マクロの記述内容はほとんど理解できないのですが， どなたか助けて頂けませんか！ ちなみにエクセルは2016版です． http://www.geocities.jp/tomtomf/denki/AC2/ac2.htm http://www.geocities.jp/tomtomf/denki/AC1/ac1.htm 以下はコピー定義した「 IMMULT」関数と「 IMINVERS」関数のマクロです． Public Function IMMULT(a As Range, b As Range) As Variant Dim r1 As Integer, r2 As Integer, c1 As Integer, c2 As Integer, nn As Integer Dim r As Integer, c As Integer Dim cr As Integer, cc As Integer Dim n As Integer Dim mm() As Variant r1 = a.Rows.Count r2 = b.Rows.Count c1 = a.Columns.Count c2 = b.Columns.Count If (c1 = r2) Then nn = c1 Else Exit Function End If cr = r1 cc = c2 ReDim mm(1 To cr, 1 To cc) For r = 1 To cr For c = 1 To cc mm(r, c) = 0 For n = 1 To nn mm(r, c) = IMSUMa(mm(r, c), IMPRODUCTa(a.Cells(r, n), b.Cells(n, c))) Next Next Next IMMULT = mm End Function Public Function IMINVERS(a As Range) As Variant Dim n As Integer, n1 As Integer, n2 As Integer Dim r1 As Integer, r2 As Integer, c As Integer Dim max As Variant Dim i As Integer Dim m() As Variant Dim inm() As Variant Dim rr As Integer, cc As Integer Dim no As Integer, ex As Variant n1 = a.Rows.Count n2 = a.Columns.Count n = n1 ReDim inm(1 To n1, 1 To n2) For rr = 1 To n1 For cc = 1 To n2 If rr <> cc Then inm(rr, cc) = 0 Else inm(rr, cc) = 1 'End If Next Next ReDim m(1 To n1, 1 To n2) m = a If n1 <> n2 Then IMINVERS = False Exit Function End If For r1 = 1 To n max = m(r1, r1) no = r1 If r1 < n Then For i = r1 + 1 To n If IMABSa(m(i, r1)) > IMABSa(max) Then max = m(i, r1) no = i End If Next If (r1 <> no) Then For i = 1 To n ex = m(r1, i) m(r1, i) = m(no, i) m(no, i) = ex Debug.Print m(r1, i), m(no, i) ex = inm(r1, i) inm(r1, i) = inm(no, i) inm(no, i) = ex Next End If End If max = m(r1, r1) For i = 1 To n m(r1, i) = IMDIVa(m(r1, i), max) inm(r1, i) = IMDIVa(inm(r1, i), max) Next For r2 = 1 To n If r1 <> r2 Then max = m(r2, r1) For i = 1 To n m(r2, i) = IMSUBa(m(r2, i), IMPRODUCTa(m(r1, i), max)) inm(r2, i) = IMSUBa(inm(r2, i), IMPRODUCTa(inm(r1, i), max)) Next End If Next Next IMINVERS = inm End Function
- ベストアンサー
- Visual Basic
- エクセルVBAで重複入力の排除
すでに入力規則はリストで使用しております。 そのためVBAで重複入力の排除を行おうと思います。 一応以下のコードでできたのですが、もっと良い方法があったら教えてください。 お願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myDic As Object Dim c As Variant, varData As Variant Dim i As Long If Application.Intersect(Target, Range("A1:A50")) Is Nothing Then Exit Sub Set myDic = CreateObject("Scripting.Dictionary") varData = Range("A1:A50").Value For Each c In varData If Not c = Empty Then i = i + 1 If Not myDic.Exists(c) Then myDic.Add c, Null End If End If Next If myDic.Count < i Then MsgBox Target & " は重複！" Application.EnableEvents = False Application.Undo Application.EnableEvents = True End If End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルのマクロで複数セル指定は？
以前（7月22日 質問No.936181）の質問でご回答を頂いたマクロなんですが、 Private Sub Worksheet_Change(ByVal Target As Range) Dim MyData As String Dim i As Integer Dim ImaNanji As String Dim SakkiNanji As String Dim ImaNanpun As String Dim SakkiNanpun As String SakkiNanpun = Cells(2, 3).Value ImaNanji = Cells(1, 3).Value ImaNanpun = Mid(ImaNanji, Len(ImaNanji) - 4, 2) If ImaNanpun <> SakkiNanpun Then Application.EnableEvents = False For i = 10 To 2 Step -1 MyData = Cells(i - 1, 2).Value Cells(i, 2).Value = MyData Next i MyData = Cells(1, 1).Value Cells(1, 2).Value = MyData Cells(2, 3).Value = ImaNanpun Application.EnableEvents = True End If End Sub A1のデータをB1からB10に一分おきにつぎつぎに書き込むというものなんですが、ひとつのセルではなく複数のセル（例えばA1からA30の30個のセル）をいっぺんに書き込むようにしたいのですが可能でしょうか？ よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- Excelマクロの配列計算が♯VALUE!となる
Excelマクロの複素数を扱う配列計算がエラーとなります． 下記HPからマクロを標準モジュールに取り込み，以前のＱＡで助けて頂き 一部修正により動作するようになりました． しかし，このマクロで定義した「 IMINVERS 」関数を実行すると，大きい 配列では「#VALUE!」となってしまいます． 助けて頂けませんか！ http://www.geocities.jp/tomtomf/denki/AC2/ac2.htm http://www.geocities.jp/tomtomf/denki/AC1/ac1.htm 〔問題の現象〕 整数の行列（６×６）以上の配列計算は「#VALUE!」となる． 複素数の行列（５×５）以上の配列計算は「#VALUE!」となってしまう． 小さい配列では正しく計算できているので，手順には問題ないようにみえます． どこに問題があるのでしょうか． 問題の「 IMINVERS」関数に関するマクロは以下の通りです。 ----------------------------------------------------------- Public Function IMABSa(a As Variant) As Variant IMABSa = Application.WorksheetFunction.ImAbs(a) End Function Public Function IMDIVa(a As Variant, b As Variant) As Variant IMDIVa = Application.WorksheetFunction.ImDiv(a, b) End Function Public Function IMPRODUCTa(ParamArray a()) As Variant IMPRODUCTa = Application.WorksheetFunction.ImProduct(a) End Function Public Function IMPRODUCTb(a As Variant, b As Variant) As Variant IMPRODUCTb = Application.WorksheetFunction.ImProduct(a, b) End Function Public Function IMSUBa(a As Variant, b As Variant) As Variant IMSUBa = Application.WorksheetFunction.ImSub(a, b) End Function Public Function IMSUMa(ParamArray a()) As Variant IMSUMa = Application.WorksheetFunction.ImSum(a) End Function Public Function IMSUMb(a As Variant) As Variant IMSUMb = Application.WorksheetFunction.ImSum(a) End Function ----------------------------------------------------- Public Function IMINVERS(a As Range) As Variant Dim n As Integer, n1 As Integer, n2 As Integer Dim r1 As Integer, r2 As Integer, c As Integer Dim max As Variant Dim i As Integer Dim m() As Variant Dim inm() As Variant Dim rr As Integer, cc As Integer Dim no As Integer, ex As Variant n1 = a.Rows.Count n2 = a.Columns.Count n = n1 ReDim inm(1 To n1, 1 To n2) For rr = 1 To n1 For cc = 1 To n2 If rr <> cc Then inm(rr, cc) = 0 Else inm(rr, cc) = 1 End If Next Next ReDim m(1 To n1, 1 To n2) m = a If n1 <> n2 Then IMINVERS = False Exit Function End If For r1 = 1 To n max = m(r1, r1) no = r1 If r1 < n Then For i = r1 + 1 To n If IMABSa(m(i, r1)) > IMABSa(max) Then max = m(i, r1) no = i End If Next If (r1 <> no) Then For i = 1 To n ex = m(r1, i) m(r1, i) = m(no, i) m(no, i) = ex Debug.Print m(r1, i), m(no, i) ex = inm(r1, i) inm(r1, i) = inm(no, i) inm(no, i) = ex Next End If End If max = m(r1, r1) For i = 1 To n m(r1, i) = IMDIVa(m(r1, i), max) inm(r1, i) = IMDIVa(inm(r1, i), max) Next For r2 = 1 To n If r1 <> r2 Then max = m(r2, r1) For i = 1 To n m(r2, i) = IMSUBa(m(r2, i), IMPRODUCTa(m(r1, i), max)) inm(r2, i) = IMSUBa(inm(r2, i), IMPRODUCTa(inm(r1, i), max)) Next End If Next Next IMINVERS = inm End Function ------------------------------------------------
- 締切済み
- Visual Basic
- エクセル 2010 マクロ 検索
http://okwave.jp/qa/q8562170.html 上記質問に追加です。 ※1 'D,E,F,G,H,I,K を検索してD,E,F,G,H,I に検索対象があった時 E,F,G,H,Iのいずれかだったら左横列の上に向かって (EならD 、FならE ・・・という具合に) 何か入力されているセルのM列の191000####をmsgboxで表示させたいです。 (画 F11セル(A-1)が検索ヒットした場合E9セル(R-01)を辿り、 その行のM列のセル(191000####)をmsgboxで表示 ※2 但し、検索結果がD列のデータだった時、その行のM列が191000####だった場合 M列の191000####をmsgboxで表示させたいです。 (画 D25セル(Y-1)対象の時) ※3 また、検索結果がD列のデータだった時、その行のM列が191000####以外だった場合 (空白だったり191000####以外の場合) M列の一番上の191000####をmsgboxで 191000####&「これは例外です」と表示させたいです。 (画 D24セル (X-1)対象の時) 現在のコードは下記のとおりです。 Sheet1に Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address <> "$A$3" Then Exit Sub Call 検索 Range("A1:A2").Clear Range("A1").Activate End Sub 標準モジュールに Sub 検索() Dim Ws1 As Worksheet, Ws2 As Worksheet Dim strKey As Variant Dim s As String Dim c As Range, bln As Boolean Dim rng1 As Range Dim cnt As Long Set Ws1 = Sheet1 Set Ws2 = Sheet2 Ws1.Select With Ws2 strKey = Application.Transpose(.Range("A1").Resize(2).Value) strKey = Join(strKey, "") End With If Trim(strKey) = "" Then MsgBox "検索キーが空です", vbCritical: Exit Sub With Ws1 Set rng1 = .Range("K2", .Cells(Rows.Count, "K").End(xlUp)) For Each c In rng1.Offset(, -10) 'D,E,F,G,H,I,Kを検索 s = c.Offset(0, 3).Value & c.Offset(0, 4).Value & c.Offset(0, 5).Value & c.Offset(0, 6).Value & c.Offset(0, 7).Value & c.Offset(0, 8).Value & c.Offset(0, 10).Value & If StrComp(s, strKey, vbTextCompare) = 0 And c.Offset(0, 2).Value = "" Then c.End(xlToRight).Activate c.Offset(0, 2).Value = Date c.Resize(1, 14).Interior.ColorIndex = 6 bln = True Exit For End If Next c If Not bln Then Ws2.Select MsgBox "リストに存在しません", vbExclamation, "NotFound" Else '加える Call ReSearch(Ws1.Range("M2"), c.Row) '再設定 Set rng1 = .Range("K6", .Cells(Rows.Count, "K").End(xlUp)) MsgBox "残り" & DoubleCountBlank(rng1.Offset(, -8), rng1) & "品目です。", vbInformation End If End With Application.Goto Ws2.Range("A1"), True End Sub Sub ReSearch(Rng As Range, j As Long) '最初のセル, 終わりの行数 Dim i As Long Dim Ws As Worksheet With Rng.Parent For i = j To Rng.Row Step -1 If CStr(.Cells(i, Rng.Column).Value) Like "191000####" Then MsgBox "指図番号 " & vbCrLf & CStr(.Cells(i, Rng.Column).Value) & " の部品です" Exit For End If Next i End With End Sub Function DoubleCountBlank(rng1 As Range, rng2 As Range) '横並びのセルのブランクをカウントする (セル範囲1 , セル範囲2) Dim i As Long Dim cnt As Long For i = 1 To rng1.Rows.Count If VarType(rng2.Cells(i, 1)) = vbDouble Then If rng1.Cells(i, 1).Value = "" And rng2.Cells(i, 1).Value <> 0 Then cnt = cnt + 1 End If End If Next i DoubleCountBlank = cnt End Function 宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
- エクセル 複数シート( VLOOKUP ユーザー定義関数
複数シート(範囲）を指定できるVLOOKUP関数をユーザー定義で作りたいと思ってます。下記のコードではうまく動かないので教えてください。 Function VLOOKUPM(検索値 As Variant, 対象シート As String, 対象セル As Range, 列番号 As Integer) As Variant Dim i As Integer Dim r As Range Dim sh As Variant Application.Volatile sh = Split(対象シート, ",") For i = 0 To UBound(sh) Set r = Sheets(sh(i)).Range(対象セル) If 検索値 = r Then VLOOKUPM = r.Offset(0, 列番号) Exit Function End If Next End Function
- ベストアンサー
- その他MS Office製品
- Excelのマクロについて
文字列から数値だけを抽出するマクロを見つけたのですが、抽出するデータを選択してから実行しなければなりませんでした。 抽出するデータはAセル以下にしかないので、データを選択しないでも実行できるようにするにはどうしたら良いのでしょうか？ 宜しくお願いします。 以下見つけたマクロです。 Sub test() Dim mydata As String Dim c As Range Dim i As Integer For Each c In Selection mydata = "" For i = 1 To Len(c) If Mid(c, i, 1) >= 0 And Mid(c, i, 1) <= 9 Then mydata = mydata & Mid(c, i, 1) End If Next c.Offset(0, 1) = mydata Next End Sub
- 締切済み
- オフィス系ソフト
- エクセルマクロでEnd Subが見つからないとでる
Excelのマクロ記述についての質問です． 以下のマクロはエクセルにない関数「IMMULT」をあらかじめ定義するためのものです．（技術計算のHPより入手し，コピーして貼り付けたものです） これを実行すると「End Subがみつからない」と出てしまいます．End Subは記述しているのになぜでしょうか，どなたか解決策を教えて頂けませんか！ Sub 関数定義() Public Function IMMULT(a As Range, b As Range) As Variant Dim r1 As Integer, r2 As Integer, c1 As Integer, c2 As Integer, nn As Integer Dim r As Integer, c As Integer Dim cr As Integer, cc As Integer Dim n As Integer Dim mm() As Variant r1 = a.Rows.Count r2 = b.Rows.Count c1 = a.Columns.Count c2 = b.Columns.Count If (c1 = r2) Then nn = c1 Else Exit Function End If cr = r1 cc = c2 ReDim mm(1 To cr, 1 To cc) For r = 1 To cr For c = 1 To cc mm(r, c) = 0 For n = 1 To nn mm(r, c) = IMSUMa(mm(r, c), IMPRODUCTa(a.Cells(r, n), b.Cells(n, c))) Next Next Next IMMULT = mm End Sub
- ベストアンサー
- Excel（エクセル）
- このマクロの説明をお願いします
Dim buf As String Private Sub CommandButton1_Click() End Sub Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim tmp As Variant Application.EnableEvents = False tmp = InStr(2, buf, "$", vbTextCompare) tmp = Right(buf, Len(buf) - tmp) If buf = "$B$" & tmp Then Range("C" & tmp).Value = Range("C" & tmp).Value + Range("B" & tmp).Value Range(buf).Select End If Application.EnableEvents = True End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) buf = ActiveCell.Address End Sub どうやらB列の各セルに入力がされた場合、隣接するC列のセルに加算していくマクロのようです。 なんですが、 InStr関数、Right関数、Len関数あたりでやっていることがよくわかりません。 Private Sub CommandButton1_Click()は必要なのでしょうか？ あと、 もっとシンプルなマクロができるようでしたらご教授ねがいます。
- 締切済み
- Visual Basic
- マクロで色が同じになるように設定したい
こんにちは。 現在マクロに挑戦中なのですが、一点分からず戸惑っています。 お分かりになる方教えてください。 下記のマクロを書きました。 Sheet2のセルに数字を入れることによってSheet1のセルの色が変わるようにしています。 25以上の数字は全て青（カラー番号5）表示にしたいのですが、どのように記したら良のか教えてください。 --------------------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim iColors As Variant Dim i As Integer Dim j As Integer iColors = Array(36, 20, 24, 37, 40, 39, 17, 22, 45, 43, 28, 6, 4, 41, 18, 47, 50, 46, 10, 7, 3, 21, 9, 5) For Each c In Target If c.Value <> "" Then If IsNumeric(c.Value) Then i = c.Value If i > 0 And i < 25 Then j = iColors(i - 1) Else j = 2 End If End If End If i = c.Row If i > 2 And j > 0 Then Worksheets("Sheet1").Range("B3:K6").Cells(i - 3).Interior.ColorIndex = j End If Next c End Sub --------------------------------------------------------------- お分かりになる方、宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
お礼
わかり易く解説していただきありがとうございます。 シートモジュールにも色々あるのですね・・。 今後のマクロの勉強に役立てていきます。 今回は度重なる質問にレスいただきましてありがとうございました。