【VBA】MsgBoxの文字数について

前へ 次へ
このQ&Aのポイント
  • VBAのMsgBoxを使用して、各シートの合計値と総計を表示するコードで、シート数が多い場合にメッセージボックスに収まりきらない問題の対処法を教えてください。
  • VBAのMsgBoxを使ってシートの合計値と総計を表示するコードですが、シート数が多い場合にメッセージボックスに収まりきらない問題があります。この問題の対処法を教えてください。
  • VBAのMsgBoxを使用して各シートの合計値と総計を表示するコードですが、シート数が多い場合にメッセージボックスに全て表示されない問題があります。この問題の解決策を教えてください。
回答を見る
  • ベストアンサー

【VBA】MsgBoxの文字数について

下記のコードを使い、MsgBoxに 各シートの合計値と、それらの総計 を表示しますが、シート数が膨大の時は、メッセージボックスに収まり切りません。 対処法をご教示願います。 Dim i As Long Dim mMsg As String: mMsg = "" Dim mSum As Long For i = ActiveSheet.Index To Sheets.Count mMsg = mMsg & Sheets(i).Name & " : " & Sheets(i).Cells(Rows.Count, "A").End(xlUp).Offset(0, 4).Value & vbCrLf mSum = mSum + Sheets(i).Cells(Rows.Count, "A").End(xlUp).Offset(0, 4).Value Next Sheets(1).Select MsgBox mMsg & "総計 : " & mSum, vbInformation

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

  • ベストアンサー
  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

Debug.Printを使ってはどうかな。 MsgBoxのために、今までの中間結果をだして、それを累積結合して、最後に長々した文字列を出して何の意味があるのか、判らない。MsgBoxの表示や利用は、初めの何かの報告、終わりの報告、異例事態などを知らせるとか、に使われて、少数のテストには重宝するが、全数について出すと、時間がかかるので、普通は使わない。 ・テキストボックスに累積して出す ・テキストファイルなどに都度書き出す。 ・シートのセルに書き出す などが普通では。 ーー その後のmMsgのデータの使いかたが説明されていなくて、よく質問の趣旨がわからない。 ＞MsgBox mMsgの必要な意味がわからない。初心者の我流では。 ーー 標題のいみがよくわからない。 ＞MsgBoxの文字数について についての制限文字数を知りたいのか。 「msgbox 最大文字数」でGoogleで照会すれば仕舞。 1 バイト文字で約 1,024 文字 ーー 他に https://oshiete.goo.ne.jp/qa/9109606.html メッセージボックスで1025文字以上を扱う という記事もあるようだ。 VBAでは、WEB記事を活用せよ。

0611birth
質問者

お礼

imogasi 様 「累積結合して、最後に長々した文字列を出して何の意味があるのか」 ここがポイントでした。各シートの「総計」確認が目的ですので、各シート計を表示するコードを 削除し、目的通りの結果を得られました。 有難うございました。

その他の回答 (1)

  • kkkkkm
  • ベストアンサー率65% (1615/2454)
回答No.1

ユーザーフォームにテキストボックスを作成してそこにデータを入れてみてください。 テキストボックスのプロパティで MultiLineとEnterKeyBehaviorを「True」にしておいてください。

0611birth
質問者

お礼

kkkkkm 様 ご回答有難うございました。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Excel（エクセル）

関連するQ&A

  • マクロ　行を切り取ってペーストでエラーになる

    J列に「0」と「#N/A」の行を切り取って集計対象外シートに貼り付けるといったコードです。 何故か途中でエラーになります。 どこが間違っておりますか？ 宜しくお願いします。 Dim LastRow As Long LastRow = Cells(Rows.Count, 10).End(xlUp).Row For i = 1 To LastRow If Cells(i, 10) = "0" Or Cells(i, 10) = "#N/A" Then Rows(i).Cut Sheets("集計対象外").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If Next i

  • EXCEL　VBA 早く処理をする

    よろしくお願いします 下の構文を標準モジュールに書き込み、callで実行しているのですが 処理に時間がかかります。 処理を早くする方法と構文の簡素化のご教示をお願いします。 Application.ScreenUpdating = False For i = 1 To 12 With Worksheets(i) .Select LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A8:G" & LastRow).Sort Key1:=Range("A8"), order1:=xlAscending .Range("G8:G" & LastRow - 1).Formula = "=G7+E8-F8" LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A" & LastRow).Select Dim EndRow As Long EndRow = .Range("A" & Rows.Count).End(xlUp).Row Cells(Rows.Count, 1).End(xlUp).Offset(1, 3) = .Name & "合計" Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) = Application.WorksheetFunction.Sum(Range("E7:E" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) = Application.WorksheetFunction.Sum(Range("F7:F" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(2, 3) = "前月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) = .Range("G7") Cells(Rows.Count, 1).End(xlUp).Offset(2, 5) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 4) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 3) = "次月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(4, 3) = "合計" Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) - Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(4, 4) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) Cells(Rows.Count, 1).End(xlUp).Offset(4, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(1, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(2, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(4, 6) = Cells(Rows.Count, 1).End(xlUp).Offset(0, 6) .Range("C7").End(xlDown).Select Selection.Offset(4, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 2).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 3).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 4).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(0, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 2).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 3).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 4).Borders(xlEdgeBottom).Weight = xlThin End With Next i Application.ScreenUpdating = True

  • Excel VBA; 複数のループ処理

    ↓のようなコードがあります。 Dim i As Long, MaxRow1 As Long, MaxRow2 As Long MaxRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row MaxRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To MaxRow1 Worksheets("Sheet1").Cells(i, 1).Value = i . Next i For i = 1 To MaxRow2 Worksheets("Sheet2").Cells(i, 1).Value = i . Next i これらを最大行の多いシートに合わせて、パフォーマンスを良くしたいと思います。 同様の処理をシート1、シート2で実施しているので纏めて記述したいです。 シート1、シート2に対する処理をサブルーチンにする方法しかありませんか? どなたかお願いします。 If MaxRow1 >= MaxRow2 Then For i = 1 To MaxRow1 Else For i = 1 To MaxRow2 End If Worksheets("Sheet1").Cells(i, 1).Value = i Worksheets("Sheet2").Cells(i, 1).Value = i . Next i

  • ＶＢＡ　任意のシートからコピーを始める。

    教えてください。 全てのシートをコピーして一つのシートにまとめるプログラムシートを作成しました。 1番目のシートからコピーを始める場合は For i = 2 To Worksheets.Count 2番目のシートからコピーを始める場合は For i = 3 To Worksheets.Count とすればよいのですがこれだといちいちモジュールコードを出して数字を変更しなければならず面倒です。 そこでユーザーフォームのコンボボックスに任意の数字を入れてクリックを押せば希望するシートからコピーを始めるプログラムを作成してみましたがうまくいきません。どなたか教えてくださいませんか。 Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long, lRow3 As Long, SNo As Integer '----何番目からコピーを始めるかを決定します With UserForm2 SNo = .ComboBox1.value End With For i = 1 + SNo To Worksheets.Count With Worksheets(i) lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 lCol = .Cells(1, Columns.Count).End(xlToLeft).Column '----シートのデータが2行以上の場合にコピーします If lRow >= 2 Then lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 If lRow2 < Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 Then lRow2 = Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 .Activate .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1) End If End With Next i

  • ユーザーホームでの検索について（エクセル）

    コンボボックスで選択した文字とシートの表にある文字が一致か不一致かでMsgBoxに表示させるコードです。 一番上の行を選択しコマンド1ボタンを押すと正常に表示されるが2行目以降を選択すると一致不一致に関わらずすべて注意文が表示されます。 　現在シート2,3ともとも10行目までデータがあります。今後データは下の行へと増える予定です。 　コマンドボタン１のコード Private Sub cmd検索_Click() Dim i As Long For i = 4 To Sheets("sheet3").Cells(Rows.Count, 3).End(xlUp).Row If Sheets("sheet3").Cells(i, 3) = ComboBox1 Then MsgBox "商品 『 " & Sheets("sheet3").Cells(i, 3).Value & " 』 の在庫数は 『 " & Sheets("sheet3").Cells(i, 9).Value & " 』 です。" Exit Sub Else MsgBox "その商品は登録されていません。", vbExclamation Exit Sub End If Next i End Sub コンボボックスのコード Private Sub UserForm_Initialize() Dim i As Long With Worksheets("sheet2") For i = 4 To .Cells(Rows.Count, 3).End(xlUp).Row ComboBox1.AddItem .Cells(i, 3).Value Next i End With End Sub どこが間違っているのか教えていただけないでしょうか。 よろしくお願いいたします。

  • VBA　高速化

    以下のコードを改良して早く処理できるようにしたいです。素因数分解をして、素因数の数を数えるプログラムです。 Sub 素因数を数える() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim I As Long, j As Long, cnt As Long, wS As Worksheet, k As Long, Set wS = Worksheets("Sheet2") k = Worksheets("Sheet1").Range("A100010").End(xlUp).Row - 1 For dd = 3 To k Call aaa(Range("A" & dd)) Next dd Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Private Sub aaa(ByVal Target As Range) Set wS = Worksheets("Sheet2") If Intersect(Target, Range("A:A")) Is Nothing Or Target.Count > 1 Then Exit Sub With Target If Not IsNumeric(.Value) Then Exit Sub If .Value Mod 1 = 0 Then Range("D1") = .Value For I = 1 To wS.Cells(Rows.Count, "A").End(xlUp).Row Do While Cells(Rows.Count, "D").End(xlUp) Mod wS.Cells(I, 1) = 0 cnt = cnt + 1 Cells(Rows.Count, "D").End(xlUp).Offset(1) = Cells(Rows.Count, "D").End(xlUp) / wS.Cells(I, 1) Loop If Cells(Rows.Count, "D").End(xlUp) = 1 Then Exit For Next I End If .Offset(, 1) = cnt End With Range("D:D").Clear End Sub 以前教えていただいたコードを使って書きました。 どういう状況で使っているかといいますと、シート1のＡ列に自然数を2から順番に並べ、シート2のＡ列に素数を並べておき、プログラムを実行すると、Ｂ列に素数の数が表示されるという具合です。 大変役に立っていたのですが、10萬ほどのデータを扱おうとすると、自分のコンピュータでは時間がかかりすぎます。そこでコードを改良して高速化をしたいのです。 いま考えられる改良点は、 1、Ｄ列を使って行っている処理をメモリで行うようにして、セルへのアクセスを省けないか 2、aaaの5行目の、"wS.Cells(Rows.Count, "A").End(xlUp).Row"この処理を簡単な変数の処理で代用できないか ということです。他にも高速化できる方法があれば教えてください。 よろしくお願いします。

  • msgboxの表示

    Ａ列の値とC列の値をMsgboxに表示するにはどうしたらいいのでしょうか？C列で一番高い商品とその品名A列を表示させたいのですが・・ Sub hinmei() Dim i As Long For i = 2 To Range("C65535").End(xlUp).Row Dim x As Long Dim a As Long x = Cells(i + 1, 5) If Cells(i, 5).Value < x Then a = x End If Next MsgBox a End Sub

  • セルの値から任意の文字のみを抽出する

    こんにちは。 VBA勉強中です。 どうしても詰まってしまったので力を貸してください。・゜・(ノД｀)・゜・。 Sheet１にはA列～J列にデータが入っています（行数は3行目～□行目・・・都度変わります） Sheet2には抽出したい文字の一覧（仮に禁止ワードとします）がB列5行目～○行目まで入ってます。 質問としてはSheet１のB列、D列、F列のそれぞれの値より禁止ワードを抽出する。 1つのセルに禁止ワードが0～最大5つ入っている時にK列から→方向に禁止ワードを並べて行くといった 感じです。 わかりにくくてすみませんが宜しくお願い致します。 以下自分で考えてみたコードです。。 これだと始めのB列のみ抽出に成功しましたがその他の列からは抽出できず・・・。゜(PД｀q。)゜。 列Bで使用したコードをD列、F列にも使えると下に数値のみ変えて羅列しただけだからでしょうか；ｗ； 本当に初心者ですみません。。 以下コードです。 Sub 禁止ワード抽出() Dim SR As Integer , LR As Integer, SR2 As Integer , LR2 As Integer , LR3 As Integer , LR4 As Integer Dim i As Long , j As Long , k As Long , m As Long Dim KINSHI As Variant SR = 3 SR2 =5 LR = Sheets("Sheet1").Range("B" Rows.Count).End(xlUp).Row LR2 = Sheets("Sheet1").Range("D" Rows.Count).End(xlUp).Row LR3 = Sheets("Sheet1").Range("F" Rows.Count).End(xlUp).Row LR4 = Sheets("Sheet2").Range("B" Rows.Count).End(xlUp).Row For j = SR2 To LR4 KINSHI = Sheets("Sheet2").Cells(j , 2).Value For i = SR To LR If Sheets(Sheet1).Cells(i , 2).Value Like ("*" & KINSHI & "*") Then If Cells(i , 10) = "" Then Cells(i , 10) = KINSHI Else 　 If Cells(i , 10 + 1) = "" Then Cells(i , 10 + 1) = KINSHI 　　　　　　　　　　 Else 　 If Cells(i , 10 + 2) = "" Then Cells(i , 10 + 2) = KINSHI Else 　 If Cells(i , 10 + 3) = "" Then Cells(i , 10 + 3) = KINSHI Else 　 If Cells(i , 10 + 4) = "" Then Cells(i , 10 + 4) = KINSHI End If End If End If End If End If End If Next i , j 以下上記コードをD列、F列バージョンで並べています・・・・ End Sub 恐らくOffsetプロパティを使う方がいいと思いましたが中々うまくいかず 自分なりに色々考えてみてこんな残念な結果になってしまいましたが 皆様のお力添えどうぞ宜しくお願い致します。

  • 列を変更して転記したいのですが。

    すみません、誰か教えていただけませんか。 A列に値が入力がされていて、その値をF列に転記していき 15行までいけば２列横にズレて転記していき更に、15行で 2列横と続けたいのですがうまく出来ません。 下記のように記述してみたのですが、値が置き換わるだけで 転記出来ません。 誰か教えて頂けませんでしょうか。 Sub TEST() Dim i As Long, ii As Long Dim myR As Long myR = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row ii = 5 For i = 1 To myR Cells(1, ii).End(xlUp).Offset(0, 1).Value = Cells(i, 1).Value If Cells(1, ii).End(xlUp).Row = 15 Then ii = ii + 2 End If Next i End Sub 宜しくお願いします。

  • ExcelVBAで画像の様に動作を変更したいです

    先日、こちらにて 教えていただいたマクロでのデータ突合方法を基にマクロを作成中なのですが、 画像の様に動作させるにはどう修正すればよいでしょうか （目標） 画像のSheet1 と Sheet2の商品コードを上から順に突合し、 Sheet3に合致したA品番をコピー Sheet4に合致したB品番をコピー Sheet5に合致しなかったA品番をコピー Sheet6に合致しなかったB品番をコピー ※なお、A品番B品番ともに同じ値の品番がいくつか存在することがある。 この場合は、ループ中既に合致したデータは対象から外す。 判別方法は品番の一つ横のセルに”〇”を表記。（フラグを立てる） 「A品番＝B品番」のとき「Offset(0, 1)が”〇”」ならば合致しない　 --------------------------------------------------- （手順） (1)Sheet1 あり Sheet2 ありの場合 →一致したSheet1とSheet2のOffset(0, 1)に”〇” →一致したSheet1の行全体の値をSheet3にコピー →一致したSheet2の行全体の値をSheet4にコピー (2)Sheet1 あり Sheet2 なしの場合 →該当するSheet1の行全体の値をSheet5にコピー (3)Sheet1 なし Sheet2 ありの場合 →該当するSheet2の行全体の値をSheet6にコピー --------------------------------------------------- （現在のコード） Sub Test() Dim c As Range, FRange As Range Dim Sh1 As Worksheet, Sh2 As Worksheet Set Sh1 = Worksheets("Sheet1") Set Sh2 = Worksheets("Sheet2") For Each c In Sh1.Range(Sh1.Cells(3, "A"), Sh1.Cells(Rows.Count, "A").End(xlUp)) Set FRange = Sh2.Range(Sh2.Cells(3, "A"), Sh2.Cells(Rows.Count, "A").End(xlUp)). _ Find(c.Value, LookAt:=xlWhole, After:=Sh2.Cells(Rows.Count, "A").End(xlUp)) If Not FRange Is Nothing Then If c.Value = FRange.Value And FRange.Offset(1, 0).Value <> "◯" Then c.Offset(0, 1).Value = "◯" '↓(1).xlsmSheet2に Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value FRange.Offset(0, 1).Value = "◯" End If Else '↓(1).xlsmのSheet3に Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value End If Next For Each c In Sh2.Range(Sh2.Cells(3, "A"), Sh2.Cells(Rows.Count, "A").End(xlUp)) If c.Offset(0, 1).Value = "◯" Then '↓(2).xlsmのSheet2に Sheets("Sheet4").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value Else '↓(2).xlsmのSheet3に Sheets("Sheet6").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value End If Next End Sub ご指導頂ければ幸いです。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する