VBAマクロの注釈方法について

2023/11/04 14:23

このQ&Aのポイント

VBAマクロの中で特定の条件に合致する場合に注釈をつける方法を教えてください。
担当者が変わった際に、VBAマクロの中に注釈を追加する方法が知りたいです。
VBAマクロのコードの一部が理解できないため、その部分に注釈をつける方法を教えてください。

ベストアンサー

教えて頂いたマクに注釈をつけておきたいのですが・・

2022/05/31 08:03

度々の質問となり申し訳ございません。 kkkkkmさんにご教示頂いたvbaマクロに、担当が変わった時のために注釈をつけておきたいのですが、いろいろ調べたのですが、下記の部分が私の頭ではよくわかりませんでした。どの様に注釈をつけておけばよいか教えて頂けますでしょうか。宜しくお願い致します。「 If Trim(StrConv(Ws1.Cells(i, j).Value, vbNarrow)) = Trim(StrConv(List(1)(k, 1), vbNarrow)) Then mTotal(1) = mTotal(1) + Ws1.Cells(i, j).Offset(0, 2).Value」

lunar-eclipce
お礼率67% (50/74)

Excel（エクセル）
回答数2
ありがとう数2

みんなの回答 （2）
専門家の回答

質問者が選んだベストアンサー

ベストアンサー

kkkkkm
ベストアンサー率65% (1620/2460)

2022/05/31 08:31 回答No.1

If Trim(StrConv(Ws1.Cells(i, j).Value, vbNarrow)) = Trim(StrConv(List(1)(k, 1), vbNarrow)) Then mTotal(1) = mTotal(1) + Ws1.Cells(i, j).Offset(0, 2).Value 比較対象のどちらに全角や前後のスペースが存在するのか不明なので、両方とも半角にし前後のスペースを削除して同じ条件にして比較しています。 StrConv(対象, vbNarrow) 対象を半角にします。 Office TANAKA StrConv http://officetanaka.net/excel/vba/function/strconv.htm Trim(対象) 対象の前後のスペースを削除します Office TANAKA Trim http://officetanaka.net/excel/vba/function/Trim.htm mTotal(1) = mTotal(1) + Ws1.Cells(i, j).Offset(0, 2).Value 費目コード,項目名,金額なので Ws1.Cells(i, j)が費目コードで、金額のセルは2列右側のセルになりますので.Offset(0, 2)になります。これだけはおさえるセル操作（1）－Offsetで自由自在 https://www.moug.net/tech/exvba/0050057.html

質問者

お礼 2022/05/31 21:01

ご回答有難うございます。単体の意味からなかなか線で繋がらなかったのですが、文字にして頂いて理解することが出来ました。とても助かりました。

その他の回答 (1)

imogasi
ベストアンサー率27% (4737/17068)

2022/05/31 09:49 回答No.2

一般論として、経験からの参考に。（A）コード１行や１行のその部分のやってる意味・目的を解説する。　　　＜ーーこの部分で何をやってるのだろうか？（B）塊の２－３行について、　　　　・やっている目的　や　（例　探す、比較する、修正する、採ってくる、データを変形する、データチェックする、同型の処理を繰り返すなど）　　　　いろいろなレベルでのもの（目的の表現）が考えられるので、適宜工夫する。　　　　・採った手段（例　MID関数で文字列の一部をXXするなど）　　　＜ーーどういう手段で、道具で、例えば関数で、メソッドでやってるのだろうか？　　　＜ーー繰り返し法やフィルタやFind法のどれを使ったのかなど、（Ｃ）前提条件はどんなものか。　　　意外に、他人にも、当然わかると思い込みやすい、ポイントです。　こんなことを小生は意識してます。

質問者

お礼 2022/05/31 19:22

ご回答有難うございます。大変参考になりました。

関連するQ&A

VBA　請求データ一覧からの複数の処理
先週 kkkkkmさんに質問をさせて頂きまして、いろいろご指導を頂いたものです。続編の様な形になってしまいますが、抽出するデータの環境設定を変更致しました。ご質問させて頂く内容は前回とほとんど変更がないのですが、あらためて下記に記載させて頂きます。 <Worksheet1のデータ> Ｊ列～AM列までが課税金額「J,K,L」「M,N,O」・・・「AK,AL,AM」と3列1組（コード・費目・金額） 1組の行もあれば、複数組の行もあり。 AN列～BB列までが非課税金額課税金額と同じく3列1組 1組の行もあれば、複数組の行もあり。「BC」=消費税、「ＢＤ」=合計金額 ※AN列の前に不規則な空白セルあり　　BC列の前に不規則な空白セルあり文章で上手く説明出来ているか自信がありませんので、エクスポートした元データ Worksheet1と、 vbaを用いて作成した Worksheet3 をご参考に添付致します。 Worksheet1の2行目がWorksheet3の2行目に対応しています。 3行目、4行目も同様です。不規則な空白が原因でしょうか・・・。 M列、O列は問題ないのですが、金額が合わなかったり、N列に金額を引いてこないのです。実行しているコードは下記になります。 Dim i As Long, j As Long, k As Long Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet Dim mTotal(4) As Long Dim LastRow As Long Dim List(4) As Variant Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") Set Ws3 = Sheets("請求書ひな形") List(1) = Ws2.Range(Ws2.Cells(1, "A"), Ws2.Cells(Rows.Count, "A").End(xlUp)).Value List(2) = Ws2.Range(Ws2.Cells(1, "B"), Ws2.Cells(Rows.Count, "B").End(xlUp)).Value List(3) = Ws2.Range(Ws2.Cells(1, "C"), Ws2.Cells(Rows.Count, "C").End(xlUp)).Value List(4) = Ws2.Range(Ws2.Cells(1, "D"), Ws2.Cells(Rows.Count, "D").End(xlUp)).Value LastRow = UBound(List(1)) For i = 2 To 4 If LastRow < UBound(List(i)) Then LastRow = UBound(List(i)) End If Next For i = 2 To Ws1.Cells(Rows.Count, "J").End(xlUp).Row mTotal(1) = 0 mTotal(2) = 0 mTotal(3) = 0 mTotal(4) = 0 For j = Columns("J").Column To Columns("BB").Column Step 3 For k = 2 To LastRow If UBound(List(1)) >= k Then If Ws1.Cells(i, j).Value = List(1)(k, 1) Then mTotal(1) = mTotal(1) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If If UBound(List(2)) >= k Then If Ws1.Cells(i, j).Value = List(2)(k, 1) Then mTotal(2) = mTotal(2) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If If UBound(List(3)) >= k Then If Ws1.Cells(i, j).Value = List(3)(k, 1) Then mTotal(3) = mTotal(3) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If If UBound(List(4)) >= k Then If Ws1.Cells(i, j).Value = List(4)(k, 1) Then mTotal(4) = mTotal(4) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If Next Next Ws3.Cells(i, "J").Value = mTotal(1) Ws3.Cells(i, "K").Value = mTotal(2) Ws3.Cells(i, "L").Value = mTotal(3) Ws3.Cells(i, "N").Value = mTotal(4) Ws3.Cells(i, "M").Value = Ws1.Cells(i, "BC").Value Ws3.Cells(i, "O").Value = Ws1.Cells(i, "BD").Value Next Set Ws1 = Nothing Set Ws2 = Nothing Set Ws3 = Nothing End Sub 本当に何度も申し訳ございません。お時間がある時に見て頂けると有り難いです。どうぞ宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
エクセル２００３のマクロが２０１０で使えない
ＰＣ買い換えで、今まで使えていたマクロに下記のようなメッセージが表示されて使えなくなりました。他人が作成したマクロでまた、私はＶＢＡに詳しくありません。！はこのマシンで利用できないため、オブジェクトをこのマシンで読み込めませんでした。コンパイルエラー　変数が定義されていません。以下記述の一部です。 Private Sub UserForm_Initialize()　　　　　　　　　　　　　　　　　　　　←ここが黄色に Dim c As Control, i As Integer, j As Integer With data i = 1 Do Until .Cells(i + 1, 1).Value = "" i = i + 1 list01.AddItem .Cells(i, 2).Value For j = 1 To 6 list01.List(i - 2, j) = .Cells(i, j + 2).Value Next j list01.List(i - 2, 7) = .Cells(i, 1).Value Loop i = 1 Do Until .Cells(i + 1, 29).Value = "" i = i + 1 comb02.AddItem .Cells(i, 29).Value comb02.List(i - 2, 1) = .Cells(i, 30).Value comb02.List(i - 2, 2) = .Cells(i, 31).Value comb02.List(i - 2, 3) = .Cells(i, 32).Value comb02.List(i - 2, 4) = .Cells(i, 33).Value comb02.List(i - 2, 5) = Mid(.Cells(i, 29).Value, Len(.Cells(i, 29).Value) - 4, 2) comb02.List(i - 2, 6) = Right(.Cells(i, 29).Value, 2) Loop i = 1 Do Until .Cells(i + 1, 37).Value = "" i = i + 1 comb01.AddItem .Cells(i, 37).Value Loop cal01.Value = .Cells(2, 23).Value　　　　　　　　　　　　　　　　　　　← cal01が青く ymdStart = .Cells(2, 26).Value ymdEnd = .Cells(3, 26).Value Controls("opt0" & .Cells(3, 23)).Value = True chk01.Value = .Cells(4, 23).Value For Each c In Controls If Left(c.Name, 4) = "list" Or Left(c.Name, 4) = "text" Or Left(c.Name, 4) = "comb" Then c.ForeColor = .Cells(13, 25).Value c.BackColor = .Cells(16, 25).Value End If Next c End With With list01 If .ListCount = 0 Then If MsgBox("職員が登録されていません。", 48, ThisWorkbook.Name) = 1 Then End If Else ReDim GroupTable(.ListCount - 1, 1) i = 0 For j = 0 To .ListCount - 1 If .List(i, 0) <> .List(j, 0) Then i = j End If GroupTable(j, 0) = i Next j i = .ListCount - 1 For j = .ListCount - 1 To 0 Step -1 If .List(i, 0) <> .List(j, 0) Then i = j End If GroupTable(j, 1) = i Next j End If End With but07.ControlTipText = ThisWorkbook.Name & "の上書き保存" MsgMode = True Call cal01_Click Call opt04to05_Change End Sub どうしていいかわかりませんので、よろしくお願いします。 Windows7 Professional SP1 64
- 締切済み
- Windows 7
Excel 2007 マクロのIF構文について
Excel 2007 マクロのIF構文について Sheet1からSheet2にIF構文を使用して、必要な情報を転記するマクロです。下記マクロで実現できているのですが、IF構文が多くもっと効率的なマクロがあるのではないかと考えています。 IF構文が2つありますが、1つにまとめるマクロがありましたらお教えください。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '「Sheet1」シートを更新 Worksheets("Sheet1").Range("A1").ListObject.QueryTable.Refresh BackgroundQuery:=False '「Sheet1」シートから「Sheet2」シートに転記 For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, 13).End(xlUp).Row '「Sheet1」シートのL列から「Sheet2」シートのS列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "S") = ws1.Cells(i, "L") End If '「Sheet1」シートのG列から「Sheet2」シートのQ列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "Q") = ws1.Cells(i, "G") End If Next j Next i End Sub
- ベストアンサー
- その他MS Office製品
オブジェクトエラーが出る
フォームの切り替え時に同じマクロを使いたく（機能は同じなので） MultiPage1が1枚目の時と2枚目の時で入力するコンボボックスを変えておこうとしたのですがエラーで動かないようです。 If MultiPage1.Value = 0 Then COMBX = "ComboBox1" ElseIf MultiPage1.Value = 1 Then COMBX = "ComboBox7" End If name = "シート名" Set ws = ThisWorkbook.Worksheets(name) i = 2 Do Until ws.Cells(i, 9) = "" COMBX.AddItem ws.Cells(i, 9).Value　**********ここでエラー i = i + 1 Loop
- ベストアンサー
- Visual Basic
エクセルVBAで無限ループ
教えてください。以下の２つのエクセルマクロはまったく同じことをさせようとしているのですが、test02の方は.Offset(1).Activateが働かないのか、無限ループに陥ってしまいます。単にActiveCell.という記述をWith～End Withでまとめただけなのになぜこうなるのでしょうか？ Sub test01() ActiveSheet.Cells(1, 1).Activate Do While ActiveCell.Value <> "" If Not IsNumeric(ActiveCell.Value) Then ActiveCell.Offset(0, 1).Value = "文字" ElseIf ActiveCell.Value > 0 Then ActiveCell.Offset(0, 1).Value = "正数" ElseIf ActiveCell.Value < 0 Then ActiveCell.Offset(0, 1).Value = "負数" Else ActiveCell.Offset(0, 1).Value = "その他" End If ActiveCell.Offset(1).Activate i = i + 1 Application.StatusBar = i Loop End Sub Sub test02() ActiveSheet.Cells(1, 1).Activate With ActiveCell Do While .Value <> "" If Not IsNumeric(.Value) Then .Offset(0, 1).Value = "文字" ElseIf .Value > 0 Then .Offset(0, 1).Value = "正数" ElseIf ActiveCell.Value < 0 Then .Offset(0, 1).Value = "負数" Else .Offset(0, 1).Value = "その他" End If .Offset(1).Activate i = i + 1 Application.StatusBar = i Loop End With End Sub
- ベストアンサー
- オフィス系ソフト
エクセルＶＢＡ
ＶＢＡ内で、そのＶＢＡの実行を制御することは可能でしょうか？下のようなコードを作ったのですが、 Sub 承認書作成() Dim ws0 As Worksheet, ws1 As Worksheet, r1 As Range Dim i As Long Dim nyuryoku(), chikuseki() Set ws0 = Worksheets("承認書作成") Set ws1 = Worksheets("顧客データ") Set ws2 = Worksheets("業者コード") Set ws3 = Worksheets("承認通知書") Worksheets("顧客データ").Select Range("テーブル1[[#Headers],[ＮＯ．]]").Select Selection.End(xlToRight).Select Selection.End(xlDown).Select Selection.ListObject.ListRows.Add AlwaysInsert:=False Range("B7").Select nyuryoku = Array("b5", "d5", "f5", "h5", "j5", "l5", "n5", "p5", "b6", "d6", "f6", "h6", "j6", "l6", "n6", "p6", "b4", "d4") '転記したいセルの位置 chikuseki = Array("0", "1", "5", "6", "8", "9", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "53", "54") '転記先の列のオフセット値　Set r1 = ws1.Range("f" & Rows.Count).End(xlUp).Offset(0) 'データ蓄積セル　For i = 0 To UBound(nyuryoku) r1.Offset(0, chikuseki(i)).Value = ws0.Range(nyuryokui)).Value '入力 Next MsgBox "入力完了" Dim lRowNum As Long '転記先となる行番号を求める lRowNum = ws1.Cells(Rows.Count, "b").End(xlUp).Row '転記 ws3.Cells(6, "d").Value = ws1.Cells(lRowNum, "j").Value ws3.Cells(17, "g").Value = ws1.Cells(lRowNum, "c").Value ws3.Cells(22, "g").Value = ws1.Cells(lRowNum, "l").Value ws3.Cells(22, "ac").Value = ws1.Cells(lRowNum, "ab").Value 　　 Set ws0 = Nothing 　 Set ws1 = Nothing End Sub ここに、　　　If call Macro1 then call 承認書作成　'上のマクロです　　 Else: Msgbox"中止" 「Macro1を実行しないと承認書作成マクロを実行できない」というコードを組み込みたいのですが、うまくいきません。ＶＢＡ内に同じＶＢＡを組み込むことは不可能なのでしょうか？
- ベストアンサー
- オフィス系ソフト
判定してセルを塗りつぶすマクロについて
判定してセルを塗りつぶすマクロについて教えて下さい。現在下記のようなマクロがあります。 Sub オニオン判定() Dim i As Integer, j As Integer, r As Integer Dim k As Double Range(Cells(17, 9), Cells(26, 14)).Interior.ColorIndex = 0 Range(Cells(30, 9), Cells(39, 14)).Interior.ColorIndex = 0 k = Cells(5, 2) 'B5セルの値 For j = 9 To 14 For i = 17 To 26 For r = 30 To 39 If Abs(Cells(i, j).Value - Cells(r, j).Value) <= 0.05 Then Cells(r, j).Interior.Color = vbYellow Cells(i, j).Interior.Color = vbYellow End If Next Next Next End Sub 対象のIf Abs(Cells(i, j).Value - Cells(r, j).Value) <= 0.05 Then で、それぞれ見比べて、0.05以上のずれがあるとセルが塗りつぶされないというマクロなのですがこれを、If Abs(Cells(i, j).Value - Cells(r, j).Value) = 0 Thenという条件も追加してその時はセルを青に塗りつぶし、逆に0.05以上のずれがあるセルは赤に塗りつぶす。みたいなマクロを書きたいです。 If Abs(Cells(i, j).Value - Cells(r, j).Value) = 0 Thenは一度追加してみましたが上手く機能しませんでした。やりたい事・数値が動いているけど、0.05以内の時は黄色・数値変動が0の場合は青・数値変動が0.05以上の場合は赤です。宜しくお願いします。
- ベストアンサー
- Excel（エクセル）
エクセル2007 参照セルの値が認識されない
エクセル2007の環境で下記マクロを実行すると、アクティブシートのセルA1に数字が入っている場合、Sheet1のセルA1に値を転記してもそのセルA1の値をVLOOKUP関数で参照できません。マクロに問題があるためなのか何処に問題があるのか分からないので教えてください。宜しくお願いいたします。【sheet】はアクティブシートの3行目から1000行目までのA列のセルをクリックしたらセルA1に値を表示その後、下記【モジュール】を使用し、アクティブシートのセルA1が空白の場合、 A列の数値をSheet1のセルA1に転記し、アクティブシートのA列の数値が空白になるまで循環する。 Sheet1のセルA1の値をVLOOKUP関数で参照した内容を表示、印刷します。 ----------------------------------------------------------------- '【sheet】 Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Target If .Count > 1 + IsEmpty(.Value) Then Exit Sub If Application.Intersect(.Cells, Range("A3:A1000")) Is Nothing Then Exit Sub ActiveSheet.Cells(1, 1).Value = .Value End With End Sub ----------------------------------------------------------------- '【モジュール】 Sub TEST() Dim myBtn As Integer Dim myMsg As String, myTitle As String Dim WS1 As Worksheet, WS2 As Worksheet Dim i As Long myMsg = "●●●" myTitle = "確　認" myBtn = MsgBox(myMsg, vbYesNo + vbExclamation, myTitle) If myBtn = vbYes Then Set WS1 = ActiveSheet Set WS2 = Sheet1 If WS1.Cells(1, 1).Value = "" Then With WS1 For i = 3 To 65536 If .Cells(i, 1).Value = "" Then Exit For WS2.Cells(1, 1).Value = .Cells(i, 1).Value WS2.Cells(1, 2).Value = ActiveSheet.Name 'WS2.PrintOut Copies:=1 Next i End With ElseIf WS1.Cells(1, 1).Value >= 1 Then WS2.Cells(1, 1).Value = WS1.Cells(1, 1).Value WS2.Cells(1, 2).Value = WS1.Name 'WS2.PrintOut Copies:=1 Else End If End If End Sub -----------------------------------------------------------------
- ベストアンサー
- その他MS Office製品
当てはまらない場合は色付けして飛ばす
先日、完全に一致するものを削除する。http://okwave.jp/qa/q6462240.htmlにて教えていただいたことを応用して、別のVBAを作ることにしましたが、今回は必ずしもID（A列）が二つ存在するわけではないため、上下のIDを比較して違った場合は１列色づけし、比較は飛ばして次に進む、というVBAを入れたいのですが、上下同じIDを1列色づけしたり、ひとつしかないIDが続くと止まったりしてしまいます。間違いもしくは、違う考え方など教えてください。 With Worksheets("差分") For i = 1 To Range("A" & Rows.Count).End(xlUp).Row For j = 2 To 37 If Cells(i, 1).Value <> Cells(i + 1, 1) Then .Cells(i, 1).Interior.ColorIndex = 36 End If If Cells(i * 2, j).Value <> Cells(i * 2 + 1, j) Then .Cells(i * 2, j).Interior.ColorIndex = 44 .Cells(i * 2 + 1, j).Interior.ColorIndex = 6 .Cells(i * 2, 41).Value = "*" .Cells(i * 2 + 1, 41).Value = "*" Else .Cells(i * 2, 40).Value = "重複" .Cells(i * 2 + 1, 40).Value = "重複" End If Next Next End With
- 締切済み
- オフィス系ソフト
作成方法についての質問です。
下記のマクロで実行すると添付画像[現状]のようになってしまいます。私としては[こうなってほしい]の形にしたいのですが、どこに何を組み込めばよいかわかりません。誰か教えてください。 Dim Matches As Object Dim Match As Object Dim i As Long, j As Long Dim a As Variant With CreateObject("VBScript.RegExp") Set rng = Range("A1", Cells(Rows.Count, 1).End(xlUp)) Application.ScreenUpdating = False For i = 1 To rng.Rows.Count If InStr(1, rng.Cells(i, 1).Value, "(", 1) > 0 Then .Pattern = "\(([A-z\d,]+)" Else .Pattern = "([A-z\d,]+)" End If .Global = True Set Matches = .Execute(StrConv(rng.Cells(i, 1).Value, vbNarrow)) If Matches.Count > 0 Then a = Matches(0).SubMatches(0) a = Split(a, ",") Cells(i, 2).Resize(, UBound(a) + 1).Value = a End If j = 0 Next End With Application.ScreenUpdating = True Set rng = Nothing End Sub
- 締切済み
- オフィス系ソフト

VBAマクロの注釈方法について

教えて頂いたマクに注釈をつけておきたいのですが・・