• ベストアンサー

Excell VBA にて配列に定数を代入する方法

Excell-VBAにおいて、大量の定数を二次元配列に代入して行く方法をご教授願います。 下記関数は、JIS並目ねじのM数（引数:B）の知りたい形状値（たとえば「ピッチ」ならば、引数C=1）を出力するものなのですが、40行もの代入文をずらっと並べて書くしか思いつかずに居ります。 昔のN88-BASICなどではREAD～DATA文を用いて、データーを羅列して書いておけば良かったのですが、Excell-VBAにおいては良い方法はありますか？ その他の希望としましては、ワークシートからデーターを読み込む方法では、ワークシートをいじられてはおかしくなってしまいますので、VBAコードだけで完結させたいです。 また、別途データファイルを作成しておいて、Open～命令で、という手法も用いないで作成したいです。 Array関数に、ずらっとデーターを並べるのも避けたいです。 （私は、Access-VBAは多少かじっておりますが、Excell-VBAにはかなりうといです。） Function NAMIME(B, C) Dim A(40, 5), D As Single Dim I As Integer ' ピッチ 引っかかりの高さ 外径 有効径 谷の径 A(1, 1) = 0.25: A(1, 2) = 0.135: A(1, 3) = 1: A(1, 4) = 0.838: A(1, 5) = 0.729 A(2, 1) = 0.25: A(2, 2) = 0.135: A(2, 3) = 1.1: A(2, 4) = 0.938: A(2, 5) = 0.829 A(3, 1) = 0.25: A(3, 2) = 0.135: A(3, 3) = 1.2: A(3, 4) = 1.038: A(3, 5) = 0.929 ＜中略＞ A(38, 1) = 5.5: A(38, 2) = 2.977: A(38, 3) = 60: A(38, 4) = 56.428: A(38, 5) = 54.046 A(39, 1) = 6: A(39, 2) = 3.248: A(39, 3) = 64: A(39, 4) = 60.103: A(39, 5) = 57.505 A(40, 1) = 6: A(40, 2) = 3.248: A(40, 3) = 68: A(40, 4) = 64.103: A(40, 5) = 61.505 D = -1 For I = 1 To 40 If A(I, 3) = B Then NAMIME = A(I, C): D = 0 End If Next I If D Then NAMIME = "範囲外" End Function

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

  • ベストアンサー
  • hana-hana3
  • ベストアンサー率31% (4940/15541)
回答No.2

データをシートに記載して、そのシートを非表示（.Visible = xlVeryHidden）にして仕舞えば、マクロ操作以外の方法で表示させる事はできません。 http://www.officetanaka.net/excel/vba/sheet/sheet06.htm

truth77
質問者

お礼

ご回答、ありがとうございます。 Excelシートを非表示にすることが出来るのですね！ Accessではフォームだけを表示させて、テーブルの不正（不注意）書き換えを防いでいましたので、同様な方法が使えるとはありがたいです。

その他の回答 (1)

  • BLUEPIXY
  • ベストアンサー率50% (3003/5914)
回答No.1

DATA 文がガマンできるなら、それをシミュレートするようなコードを書けば良いと思います。 例えば、 Public A(40, 5) As Single Private Sub initialize() Const data_str As String = _ "0.25,0.135,1,0.838,0.729," & _ "0.25,0.135,1.1,0.938,0.829," & _ "0.25,0.135,1.2,1.038,0.929," & _ '＜中略＞ "5.5,2.977,60,56.428,54.046," & _ "6,3.248,64,60.103,57.505," & _ "6,3.248,68,64.103,61.505" Dim data Dim i As Integer, j As Integer, k As Integer data = Split(data_str, ",") k = 0 For i = 1 To UBound(A, 1) For j = 1 To UBound(A, 2) A(i, j) = CSng(data(k)): k = k + 1 Next Next End Sub とかすればイイと思います。 A( )は、いちいち初期化するのもなんなので、Function MAMIMEから外にだしてブックオープン時などに一度初期化(initializeの呼び出し)します

truth77
質問者

お礼

ご回答、ありがとうございます。 起動時にSubをCallして、事前に配列に読み込ませておく手段ですね。 付加も”と＆くらいで済みそうですし、記載した程度の小規模配列にはピッタリの手法かと思います。 ご教授、ありがとうございました。 ＞DATA 文がガマンできるなら 実は、これ以上の二次元データを扱いたいので、この先も、こんなに苦労して打ち込まなければならないのかなぁ。。。と悩んでいたところなんです。 扱うデータはJISなどの規格物で、そうそう変更があるものではないですから、データ列を一度関数化しておけば、何度もの使い回しに耐え得るので、たくさん作って蓄えておきたいのです。 フリーソフトでもJISの便覧があったりするのですが、パスワードが設定されていたりして、編集が出来なかったりするので、自作にチャレンジしているところなのです。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • EXCEL VBAの配列でわかりません。

    こんなコードがあるのですが、最後の他のシート（作業中シート）に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ～？？わからな～い？？おしえてくださーい！！ Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub

  • VBA マクロ　エラー1004　アプリケーション定義またはオブジェクト定義のエラー

    VBAで正当表と入力表の正誤判定を一気に行いたいのですが If Cells(a, b).Value = Cells(c, d).Value Thenの部分で エラー1004、アプリケーション定義またはオブジェクト定義のエラーと出てしまいます。 エラーの対処の仕方を調べたのですがわかりませんでした。 教えていただけるとありがたいです。 以下作ったプログラムです。 Sub 正誤判定() Dim a Dim b Dim c Dim d Dim e Dim i Dim j Dim x Dim y Dim hokan Dim ytate Dim xyoko a = 3 b = 21 c = 3 d = 43 e = 2 i = 1 j = 1 Do While j < 261 Do While i < 11 If Cells(a, b).Value = Cells(c, d).Value Then a = a + 1 c = c + 1 If Cells(a, b) = Cells(c, d) Then hokan = Cells(e, b).Value ytate = Range("B2:S15").Find(hokan, lookat:=xwhole).Row + 15 xyoko = Range("B2:S15").Find(hokan, lookat:=xwhole).Column Cells(ytate, xyoko).Value = Cells(ytate, xyoko).Value + 1 Else End If Else End If a = a - 1 c = c - 1 b = b + 1 d = d + 2 i = i + 1 Loop a = a + 3 c = c + 3 e = e + 3 j = j + 1 Loop End Sub

  • 【Excel VBA】日付の代入

    現在以下の操作を行いたく、コードを作成しています。 ・20～23行で各最大値を抽出し、C列に代入する ・最大値に紐づく日付をD列に代入する ・D列の日付が入ったセルを改行し、 2行目に"(曜日)"を入力する <現在のExcelデータ詳細> A20："処理1" A21："処理2" A22："処理3" A23："処理4" B19～AF19：日付 B20～AF23：任意の数字 C31：処理1の最大値 C33：処理2の最大値 C35：処理3の最大値 C37：処理4の最大値 D31、D33、D35、D37：日付 L(曜日)を入力予定 最大値に紐づく日付をD列に代入するところで 躓いています。 ご教示いただけないでしょうか。 現在のコードは下記の通りです。 Sub 最大値の取得() Dim max As Long Dim row As Integer Dim column As Integer For row = 20 To 23 max = 0 For column = 2 To 32 If Cells(row, column).Value > max Then max = Cells(row, column).Value End If Next Cells((row - 20) * 2 + 31, 3).Value = max For i = 4 To 1 Step -4 '編集中 Cells((row - 20) * 2 + 31, 4).Value = Cells(row - i, column - 1) '編集中 Next 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ですが、どのようにして組み合わせれば良いのでしょうか？

  • Access VBA での配列

    Access VBAで下記のような配列（ジャグ配列？）を作りたいと考えています。 添字[0] = ("0A","0B","0C") 添字[1] = ("1A","1B","1C","1D") VB.NETでは下記のような感じで書けたと思います。 Dim strArray(1) As Object strArray(0) = New String(2) {"0A", "0B", "0C"} strArray(1) = New String(3) {"1A", "1B", "1C", "1D"} 分かりましたら是非教えてください。 お願いします。

  • エクセルVBA

    A列を基準にBC列が空白ならAの数値を入れて、A>BならB列を更新、A<CならC列を更新 A列が数値以外ならその行をスキップ、という処理をしたいのですが Option Explicit Dim A As Range, B As Range, C As Range Dim i As Long Sub test() For i = 1 To 10 Set A = Cells(i, 1) Set B = A.Offset(0, 1) Set C = A.Offset(0, 2) If IsNumeric(A) Then Else Exit Sub End If If B.Value = "" Then B.Value = A.Value If C.Value = "" Then C.Value = A.Value If A.Value > B.Value Then B.Value = A.Value If A.Value < C.Value Then C.Value = A.Value Next i End Sub とすると数値以外の行の時点で停止してしまいます。 その行を飛ばして次の行に進むにはどうしたらいいのでしょうか？

  • Excel2003 VBA Functionの定数に関して教えて下さい

    Excel2003 VBA Functionの定数に関して教えて下さい。 例えば、 Function test(x, y) test = A * x + B * y + C End Function という数式を定義し、プログラム中で使用したいとします。 数式を見て分かる通り、xとyは変数でA, B, Cは定数です。 そして、これらA, B, Cの値を A = Cells(3,5) B = Cells(3,6) C = Cells(3,7) のようにシート上の値を使用したいのですが、 上記のようにプログラム中で宣言してもFunctionの中では値が入っていないものとみなされてしまいます。 この問題の回避のため、、 Function test(x, y) A = Cells(3,5) B = Cells(3,6) C = Cells(3,7) test = A * x + B * y + C End Function のようにFunctionの中に、定数を宣言を入れてしまうか、 Function test(x, y, A, B, C) test = A * x + B * y + C End Function のようにA, B, Cも定数ではなく、変数として扱う方法があります。 しかしながら、一つ目の方法では、こういったFunctionの数が増えてくると、 同じ定数を複数の場所で宣言することになり、後からプログラムを書き直そうとしたときに 極めて不便です。 一方で、２つめの方法では、test(x, y, A, B, C)のように、 一つのFunctionを呼び出すためにごちゃごちゃしてスペースをとり、 後から見たときに見にくくなります。 後、Constとして定義する方法もありますが、 A = Cells(3,5) のように、シート上のデータを代入する方法をとりたいと考えています。 上記以外の方法以外でもっとスマートな方法がありましたら 教えて頂けますでしょうか？

  • 動的配列が存在(要素が有る)か否かを判定できますか？

    VBAで、「For ループが初期化されていません」エラーが発生します。 動的配列が要素0の時に発生するようです。 動的配列の要素が生成された場合だけ、Forループしたいのですが、 どうやって判定すればよいのでしょうか？ ------------------------------- Dim 配列() As Integer Dim i As Integer i = 0 If (i < 0) Then ' 本当は真になったり偽になったり ReDim 配列(0 To i) 配列(i) = a + b i = i + 1 End If '' if ★★★ then '' 配列が有るか確認 For Each c In 配列 MsgBox c Next '' end if -------------------------------

  • VBA PrintArea に引数を使いたい

    お世話になります 入力ファイルのある項目を抽出したデータを出力ファイルに同一フォーマットで出力しています。 この時印刷範囲の指定を行ってますが、経験値により概算で印刷されるであろう枚数を PrintAreaに指定していて、現状では抽出データの編集されたページ以降も何枚か印刷 の対象に入っているため、ムダな紙がプリントされてしまいます。 そこでディテイルカウントなる物を設け、改ページ毎カウントアップして印刷時に、プリントエリアを指定 するところで使いたいのですが、実行時エラー'1004'PrintArea が設定できませんのエラーが出て しまいます。 指定でよい方法があったらご教示願います。以下ＶＢＡの内容です。 Sub P_Print() ' Dim D_cnt As Integer Dim sh1 As Worksheet '添字 Dim sh2 As Worksheet 'd ; 入力データ、エクセルファイルの最終行番号 Dim d As Integer 'i ; 入力データ読込件数 Dim i As Integer 'j ; 出力側シートのラインカウンタ Dim j As Integer ' (5 -> 54行の間のループ) Dim K As Integer 'k ; 出力側シートのライン行 ' (実際に書き込む行) If 諸表印刷.記録A.Value = True Then Windows("記録(A).xls").Activate End If If 諸表印刷.記録B.Value = True Then Windows("記録(B).xls").Activate End If If 諸表印刷.記録C.Value = True Then Windows("記録(C).xls").Activate End If Sheets("原紙").Select Sheets("原紙").Copy Before:=Sheets(2) Sheets("原紙 (2)").Select Set sh2 = Worksheets("原紙 (2)") Windows("データ 2013年度").Activate Set sh1 = Worksheets(combo_sel) '諸表印刷フォームで選択されたシートをセット d = sh1.Range("A65536").End(xlUp).Row K = 5 j = 5 For i = 2 To d If sh1.Cells(i, "O") = P_sel Then 　　　If j < 55 Then 'sh2.Cells(k, "A") = sh1.Cells(i, "A") 'sh2.Cells(k, "B") = sh1.Cells(i, "B") 'sh2.Cells(k, "C") = sh1.Cells(i, "C") 'sh2.Cells(k, "D") = sh1.Cells(i, "D") 'sh2.Cells(k, "E") = sh1.Cells(i, "E") 'sh2.Cells(k, "F") = sh1.Cells(i, "F") 'sh2.Cells(k, "G") = sh1.Cells(i, "G") K = K + 1 j = j + 1 　　　Else '改ページ処理、Detail1行目の編集 K = K + 8 j = 5 'sh2.Cells(k, "A") = sh1.Cells(i, "A") 'sh2.Cells(k, "B") = sh1.Cells(i, "B") 'sh2.Cells(k, "C") = sh1.Cells(i, "C") 'sh2.Cells(k, "D") = sh1.Cells(i, "D") 'sh2.Cells(k, "E") = sh1.Cells(i, "E") 'sh2.Cells(k, "F") = sh1.Cells(i, "F") 'sh2.Cells(k, "G") = sh1.Cells(i, "G") 　　　　K = K + 1 　 j = j + 1 　 D_cnt = D_cnt + 1 ←ここでディテイルカウント　+1 End If End If Next i If 諸表印刷.記録A.Value = True Then Windows("記録(A).xls").Activate ActiveSheet.PageSetup.PrintArea = "$A$1:$N$（D_cnt*58)" ←ここでエラーが出る End If If 諸表印刷.記録B.Value = True Then Windows("記録(B).xls").Activate ActiveSheet.PageSetup.PrintArea = "$A$1:$N$（D_cnt*58)" ←ここでエラーが出る End If If 諸表印刷.記録C.Value = True Then Windows("記録(C).xls").Activate ActiveSheet.PageSetup.PrintArea = "$A$1:$N$（D_cnt*58)" ←ここでエラーが出る End If End sub

  • VBAの配列について

    VBAの配列について質問があります。 以下のような配列Aと配列Bがあったとします。 やりたいことは、配列Cを作成して、配列Aと配列Bを結合したいです。 ----------------------------------------- Dim 配列A(3) 配列A(0) = 10 配列A(1) = 11 配列A(2) = 12 Dim 配列B(3) 配列B(0) = 100 配列B(1) = 110 配列B(2) = 120 ---------------------------------------- Dim 配列C(6) 配列A(0) = 10 配列A(1) = 11 配列A(2) = 12 配列A(3) = 100 配列A(4) = 110 配列A(5) = 120 ---------------------------------------- 配列Cを作るために、配列Aを拡張して、配列Bを挿入すれば可能 でありますが、関数のようなもので簡単に表現できないもので しょうか？ 何かご存知でしたが、ご教授願います。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する