- ベストアンサー
マクロを使ってカウントアップする汎用的な方法を教えてください
- ExcelのVBAマクロを使用して、特定の範囲の数字を繰り返しカウントアップする方法を教えてください。
- 現在のマクロは1から3712までの数字を12回ずつ繰り返しカウントアップしていますが、開始値と終了値を指定できるような汎用的なマクロを作成したいです。
- 具体的には、開始値と終了値を指定するInputボックスなどのフォームを使って、任意の範囲の数字をカウントアップする方法を教えてください。
- litton101
- お礼率89% (1106/1240)
- Visual Basic
- 回答数1
- ありがとう数0
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
- ベストアンサー
関連するQ&A
- vba split関数 コンマ区切り
エクセル・vbaに不慣れなためわかりづらかったら申し訳ありません。 コンマ区切りの数字をsplit関数で分割して指定セルに表示したいと考えており、以前質問し回答をいただいた内容でやりたいことが出来るようになりました。 ただし、若干出力場所等の変更を行いたいのですが、変更することが出来ません。 以前はA～C列にあるものをE～H列・J～M列・O～R列に表示する。 その際、A～C列にあるコンマ区切りの数字は3つのものと４つのものがあります。画像の上段部分をご確認ください。 その際のマクロは下記のとおりです。 Sub Test() Dim i As Long, j As Long, k As Long Dim tmp As Variant For i = 1 To 3 For j = 3 To 11 tmp = Split(Cells(j, i).Value, ",") For k = 0 To UBound(tmp) If k < 4 Then Cells(j, i).Offset(0, i * 4 + k).Value = tmp(k) End If Next Next Next End Sub 変更したいのは、AC８～AE16にコンマ区切りの数字があります。 AC列にある数字はAI8～AL16にAD列にある数字はAS8～AV16に AE列にある数字はBC8～BF16に表示したいと考えています。 コンマ区切りの数字は3つのものと４つのものがあります。 （画像の下段部分をご確認ください。） 上記のマクロでは下記の部分を変更する必要なのかと考えていますが、変更方法がわかりません。 お分かりの方教えていただけたら幸いです。 どうぞよろしくお願いいたします。 For k = 0 To UBound(tmp) If k < 4 Then Cells(j, i).Offset(0, i * 4 + k).Value = tmp(k)
- ベストアンサー
- Visual Basic
- マクロの行列の掛け算ができません
エクセルでマクロ勉強中の初心者です。 マクロで行列A（３行４列）、行列B（４行２列）の掛け算のプログラム（下記）を作っているのですが 「インデックスが有効範囲にありません」というエラーメッセージが出てしまいます。 エクセルで関数（MMULT)で同様の計算をするときちんと計算できるのですが・・・。 どなたか教えてください。 よろしくお願いいたします。 Sub s1() ' 次元の設定 Dim A(3, 4), B(4, 2), C(3, 2) N1 = 3: N2 = 4: N3 = 3 ' データの入力 (行列AとBの設定) For I = 1 To N1: For J = 1 To N2 A(I, J) = Worksheets("s1").Cells(I, J) Next J: Next I For I = 1 To N2: For J = 1 To N3 B(I, J) = Worksheets("s1").Cells(I, J + 5) Next J: Next I ' ベクトルの内積 For I = 1 To N1 For J = 1 To N3 For K = 1 To N2 C(I, J) = C(I, J) + A(I, K) * B(K, J) Next K Next J Next I ' 結果の出力 For I = 1 To N1 For J = 1 To N3 Worksheets("s1").Cells(I + 6, J + 7) = C(I, J) Next J Next I End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルで表を展開するマクロを作りたい
こんにちは。 エクセルで表を展開したいのですがマクロが作れません。 どなたか詳しい方教えて下さい。 A B C D １ 1,2,3 abc def ghi を A B C D １ 1 abc def ghi ２ 2 abc def ghi ３ 3 abc def ghi というように展開したいです。 10列目くらいまで対応したマクロが作りたいです。 Sub test() 'この行から Dim i, j, k As Long Dim myArray As Variant For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If Not Cells(i, 1) Like "*" & "," & "*" Then i = i - 1 myArray = Split(Cells(i, 1), ",") k = UBound(myArray) Rows(i + 1 & ":" & i + k).Insert For j = 0 To k Cells(i + j, 1) = myArray(j) Next j Next i For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 2) = "" Then Cells(i, 2) = Cells(i - 1, 2) End If Next i Columns("A:B").AutoFit End Sub 'この行まで これにどう付け足せばいいでしょうか？ どうかご教授お願い致します。
- ベストアンサー
- Windows XP
- VBAtest
VBAおｎ以下の Sheets("ＯＰ").Select Dim atai As String atai = Cells(2, 2).Value Dim datedata(40) As String For j = 0 To 40 If Cells(j + 3, 2).Value = "" Then Else datedata(j) = Cells(j + 3, 2).Value End If Next Dim shihyou As String For i = 1 To 2 shihyou = Cells(2, i + 2).Cells.Value Sheets(shihyou).Select Dim tmp_c As Integer For r = 1 To 10 tmp_c = 0 For c = 1 To 10 If tmp_c = 0 Then If Sheets(shihyou).Cells(r, c).Value = atai Then tmp_c = c End If Else Dim vals(40) As String For k = 0 To 40 For l = 1 To r + 41 For m = 1 To tmp_c - 1 If Sheets(shihyou).Cells(l, m).Value = datedata(k) Then vals(k) = Sheets(shihyou).Cells(l, tmp_c).Value End If Next Next Next End If Next Next Sheets("ＯＰ").Select For k = 3 To 43 Cells(k, i + 2).Value = vals(k - 3) Next Next End Sub
- 締切済み
- その他（インターネット・Webサービス）
- 抽出後にすべて表示
こんにちわ。教えて下さい。VBAに関しては初心者です。。。 今下記のコードによって、抽出をしていますが、これを コマンドボタンをクリックすることによって、すべて表示させたいと 思っています。いろいろ調べましたが、オートフィルタから全てを 表示するのはできるのですが、オートフィルタの設定をしていないので、すべて表示ができません。 どのようにすればいいか、教えていただけますでしょうか。。。 Private Sub CommandButton1_Click() Call 検索 Unload Me End Sub Private Sub UserForm_Initialize() 'A列 作業項目をComboBox1 へ登録 Dim i As Long With Sheets("リスト１") i = .Cells(.Rows.Count, "a").End(xlUp).Row ComboBox1.List = .Range("A2:A" & i).Value End With End Sub Sub 検索() Dim i&, j&, F As Boolean, tmp Dim n As Integer With Sheets("シート") tmp = .Cells(1, 1).CurrentRegion.Value For i = 4 To UBound(tmp) For j = 4 To UBound(tmp, 2) Step 6 If tmp(i, j) = ComboBox1.Value Then F = True Exit For End If Next If F = False Then .Rows(i).Hidden = True F = False Next End With End Sub
- ベストアンサー
- Visual Basic
- マクロのプロシージャーの修正
シートの加工場設定マスタの列が最初は、Ｂ列の４行目からＤ列の３０行まで あったのですが、Ｂ列が不要になったのでＢ列を削除しました。 下記のようなマクロを記述していますが何処を修正すればよいか 教えてください。 Private bmas(20,3) Sub Kmas_call() Dim i As Integer, j As Integer, k As Integer Windows("加工品.xls").Activate Sheets("加工場設定マスタ").Select For i = 1 To 20 For j = 1 To 3 Bmas(i, j) = Cells(i + 4, j + 1) Next j Next i End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルマクロの質問です
大量の計算をさせるときに「中断ボタン」等を表示することは可能でしょうか？ 例えば下記のマクロで Sub tes() For i = 1 To 250 Step 1 For j = 1 To 65530 Step 1 Cells(j, i) = 1 Next j Next i End Sub ↑を実行すると作業に時間がかかりますが、その待ち時間中に「中断は下記をクリック（Msgbox的な表示）」のように表示したいです。 ちなみにエクセル2003です！ アドバイスの程よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
- 背景色のカウント方法 その～２
いつもお世話になります。 Win7 Excell2010 です。 下記で No.2 tom04さんの「手作業で色を付けている場合のコードです」を採用させていただきました。 この時は「カウントした表」は A124:AF127 作成していてうまくいき大成功でした。 その後この表をいつも見る必要がありいちいちスクロールして見るのが面倒で上に移動したいと考えました。 前回の質問アドレス http://okwave.jp/qa/q8444714.html カウントする表は B5:AF8 カウントの対象となるのは B9:AF147 ということから私なりに考えて下記のように変更しました。 Sub 色付きセル() Dim i As Long, j As Long, k As Long, endRow As Long, endCol As Long endRow = ActiveSheet.UsedRange.Rows.Count endCol = Cells(5, Columns.Count).End(xlToLeft).Column If endRow > 147 Then Range(Cells(9, "B"), Cells(147, endCol)).ClearContents End If For j = 2 To endCol For i = 5 To 8 For k = 9 To 147 If Cells(k, j).Interior.Color = Cells(i, "A").Interior.Color Then Cells(i, j) = Cells(i, j) + 1 End If Next k Next i Next j End Sub ところがカウントしてくれるのですが「マクロボタン」をクリックするたびに倍数でカウントされます。 例えば参照図では C6 2 本当は 1 でなければ C7 2 本当は 1 でなければ 私が修正した上記のマクロのどこかに不具合があると思うのですが是非ともご指導いただけませんでしょうか。 よろしくおねがいいたします。 Tom04さんにご指導いただきながら勝手に修正したことをお詫びいたします。 お許しください。
- ベストアンサー
- Excel（エクセル）
- 置換のマクロ
すみません、基礎的なことかもしれませんが、 調べてもわかりませんでした… 下記マクロで、今はwS1のA列に置換したい文字があった場合 置換をしてくれますが、 A列だけではなく、wS1のシート全体を指定する為にはどのように書き換えればいいでしょうか…？ Replace(wS1.Cells(i, "A"), wS2.Cells(k, "A") の wS1.Cells(i, "A") を Aではなく、シート全体の指定に変えたいのです。。 Sub 置換() Dim i As Long, k As Long, wS1 As Worksheet, wS2 As Worksheet Set wS1 = ActiveSheet Set wS2 = Worksheets("置換") Application.ScreenUpdating = False For i = 1 To wS1.Cells(Rows.Count, "A").End(xlUp).Row For k = 1 To wS2.Cells(Rows.Count, "A").End(xlUp).Row If InStr(wS1.Cells(i, "A"), wS2.Cells(k, "A")) > 0 Then wS1.Cells(i, "A") = Replace(wS1.Cells(i, "A"), wS2.Cells(k, "A"), wS2.Cells(k, "B")) End If Next k Next i Application.ScreenUpdating = True End Sub 過去の質問↓の回答にあったマクロから、少し変えて使わせていただいています。 http://okwave.jp/qa/q8293972.html
- ベストアンサー
- Excel（エクセル）
- エクセルのマクロ（データの出力について）
１２３４５６７８９１０・・・・ ← 日付 田中 １ １ １ 中村 １ １ 鈴木 １１１１１ ・ ・ ・ 上のようになっている表を下記のように変換したいのですが、マクロがうまく書けません。 Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ Ｉ Ｊ Ｋ Ｌ Ｍ １ ２ ３ ４ ５ ６ ７ ← 日付 田中 中村 田中 鈴木 中村 田中 鈴木 鈴木 鈴木 鈴木 Sub test01() d = Worksheets("Sheet1").Range("A65536").End(xlUp).Row r = Worksheets("Sheet1").Range("IV2").End(xlToLeft).Column k = 4 '新規作成用の行ポインター For j = 2 To r For i = 3 To d If Worksheets("Sheet1").Cells(i, j) = 1 Then Worksheets("新規作成用").Cells(k, 2 * (j - 6)) = Worksheets("Sheet1").Cells(i, 2) k = k + 1 End If Next i Next j End Sub ここまで書いていきづまってしまいました。どなたかご指南ください。
- ベストアンサー
- その他MS Office製品
補足
s_huskyさん、早速のご教示ありがとうございました。 ご提示いただいたマクロで完璧な動作は得られたのですが、 実は前後関係を端折っておりまして・・・ご提示のものを 組み込もうとしたのですが、わけがわからなくなってしまいました・・ 本番でやりたい処理は、 (1) 二つのシートを追加 (2) それぞれシートの ・1列目：1～3712までの数字を、12回ずつ繰り返し記述しカウントアップ ・2列目：YYYYMMの下４桁 ただし、PREV_TEMPシートは2004年12月-2005年11月の下４桁 CURR_TEMPシートは2005年3月-2006年2月の下４桁 ・3列目：1列目＋2列目を文字列的に結合した数値を記述 というものでした・・・もしよろしかったら、ご教示願えないでしょうか。 Sub Macro2() Sheets.Add Sheets("Sheet1").Name = "PREV_TEMP" Sheets("PREV_TEMP").Select Dim a(44543, 2) For k = 0 To (UBound(a, 1) + 1) / 12 - 1 For j = 0 To 11 tmp1 = CStr(1 + k) tmp2 = Format(DateSerial(2004, 12 + j, 1), "yymm") a(k * 12 + j, 0) = tmp1 a(k * 12 + j, 1) = tmp2 a(k * 12 + j, 2) = tmp1 + tmp2 Next Next Range(Cells(1, 1), Cells(UBound(a, 1) + 1, UBound(a, 2) + 1)).Value = a Sheets.Add Sheets("Sheet2").Name = "CURR_TEMP" Sheets("CURR_TEMP").Select Dim b(44543, 2) For l = 0 To (UBound(b, 1) + 1) / 12 - 1 For m = 0 To 11 tmp3 = CStr(1 + l) tmp4 = Format(DateSerial(2006, 3 + m, 1), "yymm") b(l * 12 + m, 0) = tmp3 b(l * 12 + m, 1) = tmp4 b(l * 12 + m, 2) = tmp3 + tmp4 Next Next Range(Cells(1, 1), Cells(UBound(b, 1) + 1, UBound(b, 2) + 1)).Value = b End Sub