• 締切済み

VBAのコードがわからない

ある人が作成したマクロですが、当方初心者のため 内容が全く分かりません。 （フォームコントロールのコンボボックスに登録されていた マクロです） ご教授いただければ幸いです。 Sub Drop1_Change() i = Cells(3, 7).Value + 5 For j = 1 To 31 If Cells(j + 2, 4) Xor ((Cells(i, j + 26).Value = "開") Or (Cells(i, j + 26).Value = "ON")) Then Cells(j + 2, 4).Value = Not (Cells(j + 2, 4).Value) cmd_exec (j) End If Next j End Sub Sub cmd_exec(i As Integer) On i GoSub _ cmd1, cmd2, cmd3, cmd4, cmd5, cmd6, cmd7, cmd8, cmd9, cmd10, _ cmd11, cmd12, cmd13, cmd14, cmd15, cmd16, cmd17, cmd18, cmd19, cmd20, _ cmd21, cmd22, cmd23, cmd24, cmd25, cmd26, cmd27, cmd28, cmd29, cmd30, cmd31 Exit Sub cmd1: CheckBox1_Click Return cmd2: （以下cmd31まで続く） End Sub

みんなの回答

回答No.2

もっと具体的にどこがわからないのか書かないと答えようがありませんよ。 もし、「このロジック自体が何をするためのものかわからない」ということであれば、 それは、あなたが初心者であるかどうかにかかわらず、誰にもわかりません。 (1)仕様書を探しましょう。 (2)作った人を探して聞きましょう。 (3)あきらめて、やりたいことをやりたい人に聞いて、全部作り直しましょう。

  • eden3616
  • ベストアンサー率65% (267/405)
回答No.1

何が不明で、何をどう扱いたいのかが分かりませんが。 またセルの値も不明なため具体的な例を挙げることが出来ません。 また、 下記説明においては細かい構文などを説明しておりませんのでヒント程度となります。 この回答において、細かな説明につきましては他サイト様へ丸投げしております。 コード内「▼」で簡単に説明を入れています。 ★○★で参考になるサイトのURLを最下に添付いたします。 ※下記○～○で表現している箇所については、変数の値「i」「j」を 　For～Nextによる繰り返し構文により動的に変化しながら扱っている事を意味します。 ▼オブジェクト名「Drop1」の値が変更されたら実行される Sub Drop1_Change() 　　★１★ 　　▼変数iに現在選択中のシートのセルG7の値に5加えた値で格納 　　i = Cells(3, 7).Value + 5 　　★２★ 　　▼変数jの値を1から31まで1ずつ加えながら繰り返し 　　　　(For～Next間を31回繰り返す) 　　For j = 1 To 31 　　　　★３★/★４★ 　　　　▼(1)セル「3行～33行のD列」の値と、セル「AA列～BE列のi行」の値が 　　　　　「開」であるかをXorで排他的論理和を求める 　　　　▼(2)セル「AA列～BE列のi行」の値が「ON」であるか 　　　　・上記(1)、(2)のどちらかが満たされた時に(3)を実行 　　　　If Cells(j + 2, 4) Xor ((Cells(i, j + 26).Value = "開") _ 　　　　　　　　　　　　　Or _ 　　　　(Cells(i, j + 26).Value = "ON")) Then 　　　　　　▼(3)セル「3行～33行のD列」の真理値を反転して格納 　　　　　　　(真理値：True「真」またはFalse「偽」) 　　　　　　Cells(j + 2, 4).Value = Not (Cells(j + 2, 4).Value) 　　　　　　★５★ 　　　　　　▼cmd_exexプロシージャに変数jの値(1～31)を渡して呼び出し 　　　　　　cmd_exec (j) 　　　　End If 　　Next j End Sub ★５★ ▼以下cmd_execは上記Drop1_Changeから呼び出されて実行されます 　チェックボックスの番号を変数iに受け取り、 　iの値に対応するチェックボックスcmd1～cmd31のチェックボタンを 　クリック（チェック状態の反転）します。 Sub cmd_exec(i As Integer) 　～省略～ End Sub 参考サイト＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿ ★１★Cellsによるセル参照 http://home.att.ne.jp/zeta/gen/excel/c04p50.htm ★２★For～Nextによる繰り返し処理 http://officetanaka.net/excel/vba/tips/tips63.htm ★３★If～End IFブロックの条件分岐 http://www.atmarkit.co.jp/ait/articles/1403/04/news082_2.html ★４★ Xor演算子による排他的論理和 https://msdn.microsoft.com/ja-jp/library/csw1x2a6.aspx ★５★ cmd_execプロシージャ内の流れ http://officetanaka.net/excel/vba/statement/OnGoSub_OnGoTo.htm

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • 【Excel VBA】データ貼り付けの開始位置について

    Excel2003を使用しています。 先日、こちらでアドバイスをいただきながら、下記のようなマクロを作りました。内容はあるセルの値と同じ名前のシートへデータをコピーするというものです。 Sheet1に貼り付け元のデータが表形式であり、必要なデータのみ該当のシートへコピーします。マクロ実行後は、別の新しいデータをSheet1へコピペして、またマクロを実行するのですが、その際、データの貼り付け開始位置を前回マクロを実行して貼り付けられたデータから2行空けたいのですが、可能でしょうか？ ________________________________________________________________________________________________________________________________ Sub test3() Dim n As Long Dim i As Long Dim j As Long 　Worksheets("Sheet1").Activate 　　For n = 4 To Cells(Rows.Count, 2).End(xlUp).Row 　　　If Cells(n, 3).Value <> "" Then 　　　　With Worksheets(CStr(Cells(n, 3).Value)) 　　　　　　i = .Cells(Rows.Count, 3).End(xlUp).Row + 1 　　　　　　Cells(n, 2).Copy .Cells(i, 2) 　　　　　　Cells(n, 7).Resize(, 2).Copy .Cells(i, 4) 　　　　　　Cells(n, 11).Copy .Cells(i, 3) 　　　　End With 　　　End If 　　　If Cells(n, 13).Value <> "" Then 　　　　With Worksheets(CStr(Cells(n, 13).Value)) 　　　　　　j = .Cells(Rows.Count, 3).End(xlUp).Row + 1 　　　　　　Cells(n, 12).Copy .Cells(j, 2) 　　　　　　Cells(n, 17).Copy .Cells(j, 4) 　　　　　　Cells(n, 18).Copy .Cells(j, 6) 　　　　　　Cells(n, 11).Copy .Cells(j, 3) 　　　　End With 　　　End If 　　Next n End Sub

  • vbaのエラーを修正するコード(初心者です)？？

    シートの ｃ1セルに =a1+5 という式があります。 a10からa14にそれぞれ1,2,3,4,5と数字が入っています。 Sub 計算() If Cells(1, 3).Value < 10 Then Cells(1, 4).Value = 100 Else Cells(3, 1).Value End If End Sub Sub エラー() Dim i As Integer For i = 1 To 5 Cells(1, 1).Value = Cells(10 + i, 1).Value Application.Run "計算" Next i End Sub 以上のコードを書きます。 「Sub 計算」の４行目が不完全なのはあえてそうしています。 で、実行すると、当然ながらエラーが出ます。 そこで、実行時エラーを終了してa14に4.9と数字を手入力し、 再度「Sub エラー」を実行すると無事に終了です。 このエラー後の「終了→入力→実行」を「Sub エラー」の中に 書きたいんですが… 数式に関しては、例示なので触れないでください。 あくまで手順を教えていただきたいのです。 何卒ご教授ください。

  • ExcelのVBAがオーバーフローに！？

    読んで頂きありがとうございます。 以前に質問しました時に回答を頂き凄く助かっていたのですが、何故か「オーバーフロー」と表示されてしまいます。 ひょっとしたら桁なのかも知れません。 下記のVBAを教えて頂きしようしていました。 Option Explicit Sub Test() Dim c(), p(), q(), i, j, l, r, k As Long r = Range("B2").End(xlDown).Row l = Range("D2").End(xlDown).Row ReDim c(r - 2), p(r - 2), q(r - 2) For i = 1 To r - 2 c(i) = Cells(i + 2, 2).Value p(i) = Cells(i + 2, 3).Value q(i) = i + 2 Next i For i = 1 To r - 3 For j = i + 1 To r - 2 If c(i) > c(j) Then k = c(i) c(i) = c(j) c(j) = k k = p(i) p(i) = p(j) p(j) = k k = q(i) q(i) = q(j) q(j) = k End If Next j Next i For i = 1 To r - 2 Cells(i + 2, 7).Value = c(i) For j = 3 To r If Cells(j, 4).Value = c(i) Then Cells(i + 2, 8).Value = p(i) - Cells(j, 5).Value If p(i) - Cells(j, 5).Value <> 0 Then Range("B" & q(i)).Interior.ColorIndex = 6 Range("D" & j).Interior.ColorIndex = 6 End If Exit For End If Next j Next i For i = 3 To r k = 0 For j = 3 To l If Cells(i, 2).Value = Cells(j, 4).Value Then k = 1 Exit For End If Next j If k = 0 Then Range("B" & i).Interior.ColorIndex = 35 End If Next i For i = 3 To l k = 0 For j = 3 To r If Cells(i, 4).Value = Cells(j, 2).Value Then k = 1 Exit For End If Next j If k = 0 Then Range("D" & i).Interior.ColorIndex = 35 End If Next i End Sub デパックのClickすると15行目辺りの「k = c(i)」が黄色くなります。 正直言ってマクロとか全く解りませんが、コピーして使っていました。 どこをどう変更すれば良いのか教えて頂ければ助かります。 よろしくお願いします。

  • 重複データーの集計、削除

    どなたかご教授下さい。 下記のようにD列に重複する行があればI列に集計し、行削除するマクロを作成しました。 さらに、重複する基準となる列を複数(D列,F列,Ｇ列)に増やしたいのですが、上手く出来ません。 宜しくお願い致します。 Sub test() Dim i, j For i = 19 To Cells(Rows.Count, 2).End(xlUp).row - 1 For j = Cells(Rows.Count, 2).End(xlUp).row To i + 1 Step -1 If Cells(i, 4).value = "" Then Exit Sub If Cells(i, 4).value = Cells(j, 4).value Then Cells(i, 9).value = Cells(i, 9).value + Cells(j, 9).value Rows(j).Delete End If Next Next End Sub

  • Excel VBAについて

    早速ですがExcelVBAについて質問です。 年齢がN列にあるとき、M列に年代を入れたいと思います。（例：19才なら10代、30才なら30代） 以下のように作成しましたが、すべてに20と入ったり正常に動作しないときがあります。 Excelは2003で作成していますが、いずれ2007でも使いたいです。 もっと正確に実行できるコードを教えてください。 ワークシート関数での解決は望んでいません。データ数も多く他の作業もマクロで処理するのでマクロを希望しています。よろしくお願いします。 -------------------------- Sub ByAge() Range("N1").Value = "年代別" Dim i As Long, N As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 13).Value >= 60 And Cells(i, 13).Value < 70 Then Cells(i, 14).Value = 60 ElseIf Cells(i, 13).Value >= 50 And Cells(i, 13).Value < 60 Then Cells(i, 14).Value = 50 ElseIf Cells(i, 13).Value >= 50 And Cells(i, 13).Value < 60 Then Cells(i, 14).Value = 40 ElseIf Cells(i, 13).Value >= 30 And Cells(i, 13).Value < 40 Then Cells(i, 14).Value = 30 ElseIf Cells(i, 13).Value >= 20 And Cells(i, 13).Value < 30 Then Cells(i, 14).Value = 20 End If Next i MsgBox "完了！" End Sub --------------------------

  • エクセルVBAを修正したい

    数字を入力すると記号に変換になるマクロを 元ファイルを修正して作成したいのですが、 以下の記述が理解できません。 具体的にどのような処理をしているのか教えて下さい。 Do While Len(Range("C" & CStr(I)) & Range("D" & CStr(I))) > 0 For J = StartCol To EndCol If Len(ActiveSheet.Cells(12, J).Value & ActiveSheet.Cells(13, J).Value) > 0 Then tmp = "" If ActiveSheet.Cells(I, J).Value = "×" Or ActiveSheet.Cells(I, J).Value = "中止" Then ' ActiveSheet.Cells(I, J).Value = "中止" 'ActiveSheet.Cells(I, J + 1).Value = "" Else If Len(ActiveSheet.Cells(I, J).Value) = 0 Then K = -1 Else K = ActiveSheet.Cells(I, J).Value End If Select Case K Case 0 tmp = "×" Case 1 To 9 tmp = "△" Case Is >= 10 tmp = "○" Case Is < 0 tmp = "**" End Select

  • エクセルVBAを修正したい

    数字を入力すると記号に変換になるマクロを 元ファイルを修正して作成したいのですが、 同一シートにC9：M33,C9：Y25,O27：Y29といった 範囲の異なる表がある場合はセル範囲をどのように記述すれば良いでしょうか？ StartCol = 4 '開始列 EndCol = 20 '終了列 BlankCount = 0 I = 16 '開始行 L = 14 '行の指定 Do While Len(Range("B" & CStr(I)) & Range("C" & CStr(I))) > 0 For J = StartCol To EndCol If Len(ActiveSheet.Cells(L, J).Value & ActiveSheet.Cells(L + 1,J).Value) > 0 Then tmp = "" If ActiveSheet.Cells(I, J).Value = "×" Or ActiveSheet.Cells(I,J).Value = "中止" Then Else If Len(ActiveSheet.Cells(I, J).Value) = 0 Then K = -1 Else K = ActiveSheet.Cells(I, J).Value End If Select Case K Case 0 tmp = "×" Case 1 To 14 tmp = "△" Case Is >= 15 tmp = "○" End Select End If Next I = I + 1 If Len(Range("B" & CStr(I)) & Range("C" & CStr(I))) = 0 Then L = I + 1 I = I + 3 End If Loop End Sub

  • VBA初心者なのですが(Userformについて）

    まずは質問ご覧いただきありがとうございますm（＿　＿）m さっそくなのですが、次のプログラムを打つとSelect Caseのところで”指定されたオブジェクトは見つかりません”と出てしまうのですがなぜでしょうか。回答お待ちしております。 Private Sub CommandButton2_Click() Dim msg As String, i As Integer Dim ii As Integer, msg2 As String For i = 1 To 3 If Controls("CheckBox" & i).Value = True Then msg = msg & Controls("CheckBox" & i).Caption & vbCrLf End If Next i For ii = i To 2 If Controls("OptionBotton" & i).Value = True Then msg2 = msg2 & Controls("OptionBottob" & i).Caption & vbCrLf End If Next ii Select Case Controls("CheckBox" & i).Value & Controls("OptionBotton" & i).Value Case Controls("CheckBox" & i).Value = True & Controls("OptionBotton" & i).Value = False MsgBox msg & "がチェックされてます" Case Controls("CheckBox" & i).Value = False & Controls("OptionBotton" & i).Value = True MsgBox msg2 & "オン" Case Controls("CheckBox" & i).Value = True & Controls("OptionBotton" & i).Value = True MsgBox msg & "がチェックされています" & vbCrLf & msg2 & "オン" Case Else MsgBox "チェック又は、オンにしてください" End Select End Sub

  • エクセル VBAのチェックボックスについて

    お読みくださり、ありがとうございます。 エクセル初心者でございます。 エクセルのマクロなのですが、 お詳しい方、是非教えて欲しいです！汗 調子に乗って入力フォームなるものを作りました。 入力フォームの中にて、チェックボックスで「ある」「なし」の項目を入れてみたのですが、チェックしていないのに、値が入る現象が起きています汗 以下、素人が書いたコードを恥を承知で記載させていただきます。 Private Sub CheckBox1_Click() If CheckBox1.Value = True Then OK = "○" End If End Sub Private Sub CheckBox2_Click() If CheckBox2.Value = True Then NO = "×" End If End Sub Private Sub UserForm_Click() End Sub '以下のコードは、登録ボタンがクリックされたときの処理！ Private Sub 登録ボタン_Click() If TextBox1.Text = "" Then MsgBox "グッズ名を入力してください。" Exit Sub End If If TextBox2.Text = "" Then MsgBox "アプローチ先を入力してください。" Exit Sub End If With Worksheets("協賛グッズ") With Cells(Rows.Count, 2).End(xlUp) .Offset(1, 0).Value = TextBox1.Text .Offset(1, 1).Value = mori .Offset(1, 2).Value = mori2 .Offset(1, 3).Value = TextBox2.Text .Offset(1, 5).Value = TextBox3.Text .Offset(1, 6).Value = TextBox4.Text .Offset(1, 7).Value = TextBox5.Text .Offset(1, 8).Value = TextBox6.Text End With End With TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" TextBox5.Text = "" TextBox6.Text = "" CheckBox1.Value = False CheckBox2.Value = False End Sub 以上です。 おかしなところ満載かと思いますが、 チェックを入れた項目だけ値を入れたいと考えております。 おわかりになるかたおりましたら何卒お助けください汗 よろしくお願いいたします。

  • ２つのVBAを組み合わせる方法

    お世話になります、２つのVBAを組み合わせる方法で迷っています。 １つ目が Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True End Sub です。 ２つめが Private Sub Worksheet_Change(ByVal Target As Range)　 Application.EnableEvents = True If Intersect(Target, Range("R8:R38")) Is Nothing Then Exit Sub Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End Sub です。２つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか？

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する