• 締切済み

ExcelのVBAについて質問です

yumi-accessの回答

回答No.7

ユーザーフォームを使うならこんな感じで出来そうです。 Me.Controlsを使うと割と便利です。 Private Sub ToggleButton1_Click() Dim Suuchi(0 To 7) As Integer '数値数 Dim total As Integer '合計値 Dim i As Integer 'カウンタ数値 For i = 0 To 1 Suuchi(i) = Me.Controls("HakoS" & CStr(i + 1)).Value total = total + Suuchi(i) Next i MsgBox "数値の合計は「" & total & "」です", , "数値合計値" End Sub 普通のセル上の値をとろうとするとMe.Controlsは使えないようなので 下記のようになります。HakoS1~8は使えなさそうです。 Private Sub cmd計算_Click() Dim Suuchi(0 To 7) As Integer '数値数 Dim total As Integer '合計値 Dim i As Integer 'カウンタ数値 Dim iRowNo As Integer Dim cobj As Object iRowNo = 3 For i = 0 To 7 Suuchi(i) = Range("D" & iRowNo).Value total = total + Suuchi(i) iRowNo = iRowNo + 1 Next i MsgBox "数値の合計は「" & total & "」です", , "数値合計値" End Sub

関連するQ&A

  • VBA エクセル 合計

    皆様、こんにちは。 それぞれの値が入っている会計シート(シートの形式は同じ)を一つの合計シートに合計しようとしていますが、うまくいきません。具体的に、数値の合計ができません。 例えば、ある項目に対して、シートAに100が入力され、シートBには230が入力されているとすれば、合計シートに100+230=330を入力したいです。なお、全ての会計シートは"Form"というエクセルシートにあり、その数をユーザが決めますので、検索しなければいけません。そして、合計シートは"Result"にあります。 以下のように書いてみましたが、間違っているようです。 Worksheets("Result").Activate Dim SR As Integer Dim SC As Integer 'SR is start row 'SC is start column SR = 6 SC = 2 Worksheets("Form").Activate Dim i As Integer i = 68 Do While 1 = 1 If Selection.Cells(i, 4).Value = "" Then Exit Do End If i = i + 49 Loop Sum = 0 Sum = Sum + Selection.Cells(i, 4) Worksheets("Result").Activate Cells(SR + 5, SC + 2) = Sum 詳しい方に教えていただければ非常に助かります。 どうぞよろしくお願いします。

  • Excel VBAライフゲーム

    ExcelのVBAでライフゲームを作りたいのですが、次のプログラムの途中以降がわかりません。 もしよろしければ、このつづきの簡単な実行できるVBAライフゲームを教えてください。 続きのプログラムを教えていただけたら幸いです。 Option Explicit Const ALIVE As Integer = 1 Const DEAD As Integer = 0 Const SIZE As Integer = 19 Const Tmax As Integer = 100 Dim C(SIZE, SIZE) As Integer Sub LifeGame() Dim InitRate As Single Dim T As Integer Dim N As Integer Dim Cnext(SIZE, SIZE) As Integer Dim I As Integer, J As Integer InitRate = -1 Do While InitRate < 0 Or 1 < InitRate Loop For I = 0 To SIZE For J = 0 To SIZE If Rnd() < InitRate Then C(I, J) = ALIVE Else C(I, J) = DEAD End If Next J Next I For T = 1 To Tmax For I = 0 To SIZE For J = 0 To SIZE If C(I, J) = ALIVE Then Cells(I + 1, J + 1).Value = "■" Else Cells(I + 1, J + 1).Vallue = "" End If Next J Next I For I = 0 To SIZE For J = 0 To SIZE N = Count(I, J) Next J Next I For I = 0 To SIZE For J = 0 To SIZE C(I, J) = Cnext(I, J) Next J Next I Next T End Sub Function Count(I As Integer, J As Integer) As Integer End Function

  • VBAで行列を作る方法

    次のようなプログラミングで1,0,-1の要素で作られる3×3行列を全通り調べています。 この場合3の9乗通り調べることができます。 これを4×4や5×5行列など数を大きくして調べたいのですが、このプログラムを配列を使うなどして 簡単にできる方法を教えてください。 よろしくおねがいします。 Sub test() Dim a As Integer '行 Dim b As Integer '列 Dim c As Integer, i As Integer, j As Integer, d As Integer, e As Integer Dim 内積 As Integer, step As Integer Dim f As Integer, g As Integer, h As Integer, l As Integer, m As Integer, n As Integer, k As Integer, x As Integer Dim sum As Integer, total As Integer Dim aa As Integer, aaa As Integer, aaaa As Integer, bb As Integer, bbb As Integer, bbbb As Integer a = 3 '行 b = 3 '列 c = 0 内積 = 0 con = 0 sum = 0 tatal = 0 aa = 0 aaa = 0 aaaa = 0 bb = 0 bbb = 0 bbbb = 0 x = 0 For n = 0 To 2 For m = 0 To 2 For l = 0 To 2 For k = 0 To 2 For h = 0 To 2 For g = 0 To 2 For f = 0 To 2 For e = 0 To 2 For d = 0 To 2 '要素がすべて1 For i = 1 To a For j = 1 To b Cells(i, j) = 1 Next j Next i If bbbb = 1 Then Cells(a - 2, b - 2) = 0 ElseIf bbbb = 2 Then Cells(a - 2, b - 2) = -1 End If If bbb = 1 Then Cells(a - 1, b - 2) = 0 ElseIf bbb = 2 Then Cells(a - 1, b - 2) = -1 End If If bb = 1 Then Cells(a, b - 2) = 0 ElseIf bb = 2 Then Cells(a, b - 2) = -1 End If If aaaa = 1 Then Cells(a - 2, b - 1) = 0 ElseIf aaaa = 2 Then Cells(a - 2, b - 1) = -1 End If If aaa = 1 Then Cells(a - 1, b - 1) = 0 ElseIf aaa = 2 Then Cells(a - 1, b - 1) = -1 End If If aa = 1 Then Cells(a, b - 1) = 0 ElseIf aa = 2 Then Cells(a, b - 1) = -1 End If If total = 1 Then Cells(a - 2, b) = 0 ElseIf total = 2 Then Cells(a - 2, b) = -1 End If If sum = 1 Then Cells(a - 1, b) = 0 ElseIf sum = 2 Then Cells(a - 1, b) = -1 End If If con = 1 Then Cells(a, b) = 0 ElseIf con = 2 Then Cells(a, b) = -1 End If con = con + 1 Next d con = 0 sum = sum + 1 Next e sum = 0 total = total + 1 Next f total = 0 aa = aa + 1 Next g aa= 0 aaa = aaa + 1 Next h aaa = 0 aaaa = aaaa + 1 Next k aaaa = 0 bb = bb + 1 Next l bb = 0 bbb = bbb + 1 Next m bbb = 0 bbbb = bbbb + 1 Next n End Sub

  • VBA セルの値を取得する

    下記のはランダムにチーム分けするものです。 TmCnt = 5がチーム数です。 Sub Sample() Dim Total As Integer Dim TmCnt As Integer Dim Data1 As Variant Dim Data2() As String Dim i As Integer, j As Integer, k As Integer Total = Cells(Rows.Count, 1).End(xlUp).Row TmCnt = 5 Data1 = Range("A1:A" & Total).Value ReDim Data2(1 To Total) Randomize For i = TmCnt To 1 Step -1 j = Int(Rnd * i) + 1 Data2(i) = Data1(j, 1) Data1(j, 1) = Data1(i, 1) Next i For i = Total To TmCnt + 1 Step -1 j = Int((i - (TmCnt + 1) + 1) * Rnd + TmCnt + 1) Data2(i) = Data1(j, 1) Data1(j, 1) = Data1(i, 1) Next i i = 1 Do For j = 1 To TmCnt k = k + 1 Cells(i, j + 2).Value = Data2(k) If k = Total Then Exit Sub Next j i = i + 1 Loop End Sub TmCnt = 5をセル「B1」にチーム数を入力し、(例「6」「4」など)マクロを実行したいのです。 検索しましたところ、 セルの値を取得するにはRange("A1").Valueを入力だそうです。 TmCnt = 5を下記に書き換えるにはどのようにしたら良いでしょうか? Dim s As String s = Range(“B1”).Value Debug.Print(s) 宜しくお願いします。

  • VBAプロシージャの間違いを添削願います

    A列からD列にかけてデータが入力されます。B列には4桁の数値が入力されており、 この4桁の数値を利用して、次のようにデータを管理したいと思います。 1.4桁の数値が同じものを抽出する。 2.抽出された数値は、最初に出現している数値の下の行に挿入する。 3.最初に出現している数値以外は削除する。 4.各行は空行が無い状態とする。 これをプロシージャにしたものが下記です。 Sub 重複行削除() Dim lastgyou As Integer Dim i As Integer Dim j As Integer Dim atai As Integer lastgyou = Range("B1").End(xlDown).Row For i = 1 To lastgyou - 1 atai = Cells(i, 2).Value For j = i + 1 To lastgyou If atai = Cells(j, 2).Value Then If j <> i + 1 Then Rows(j).Cut Rows(i + 1).Insert Shift:=xlDown End If i = i + 1 End If Next j Next i End Sub としましたが、重複行が削除されません。 ご教授をお願いいたします。

  • VBA リーダーを選出したチーム分け

    名簿を作り、その名前をランダムでチームに分けるようにしたいです。 検索して以下のようなVBAを作成しました。 ※ チーム数は「TmCnt = 5」 Sub Sample() Dim Total As Integer Dim TmCnt As Integer Dim Data1 As Variant Dim Data2() As String Dim i As Integer, j As Integer, k As Integer Total = Cells(Rows.Count, 1).End(xlUp).Row TmCnt = 5 Data1 = Range("A1:A" & Total).Value ReDim Data2(1 To Total) Randomize For i = Total To 1 Step -1 j = Int(Rnd * i) + 1 Data2(i) = Data1(j, 1) Data1(j, 1) = Data1(i, 1) Next i i = 1 Do For j = 1 To TmCnt k = k + 1 Cells(i, j + 2).Value = Data2(k) If k = Total Then Exit Sub Next j i = i + 1 Loop End Sub 問題はA1~A5までの名前をランダムにリーダーとして各チームの1番目に配置する方法はどうしたら良いでしょうか? 宜しくお願いします。

  • EXCEL VBA

    EXCEL VBAで空白行が現れたら「小計」の文字を入力したいと思い以下のように記述しましたが、うまくいきません。どこがおかしいのか教えてください。 宜しくお願いします。 Sub write小計() Dim i As Integer Dim rowcnt As Integer rowcnt = Cells(1, 1).CurrentRegion.Rows.Count Range("B1").Select For i = 1 To rowcnt If Cells(i, 2).Value = "" Then Value = "小 計" ActiveCell.Offset(1).Select Next i End Sub

  • エクセル マクロ ループ処理の構文について

    お世話になります。エクセル初心者です。 i < j の関係があるときに、それぞれの数値をfor構文でループを回したいです。 i の数値は外部から入力される前提です。 現在、以下のような構文を考えています(istartとiendは外部から決められた数値とします)が、 この場合、jendはiend + 1とすれば良いのですが、jstartはどのように入力すれば良いでしょうか? 修正箇所を指摘(もしくは全文修正)していただけると、非常に助かります。 よろしくお願いいたします。 Sub test() Dim i As Integer Dim j As Integer Dim istart As Integer Dim iend As Integer Dim jstart As Integer Dim jend As Integer istart = 1 iend = 50 For i = istart To iend For j = jstart To jend '実行したい内容 Next Next End Sub

  • VBA A1をA2に変更したい

    またお世話になります。 下記のはランダムにチーム分けするものです。 TmCnt = 5がチーム数です。 これはA1から氏名を読み取り、C1からランダムに表を作成するものです。 A2、C2に変更したいのです。 Data1 = Range("A1:A" & Total).Value A1をA2に変えましたが、「インテックスが有効範囲にありません」とエラーメッセージが出ます。 どこが違うのでしょうか? 宜しくお願いします。 Sub Sample() Dim Total As Integer Dim TmCnt As Integer Dim Data1 As Variant Dim Data2() As String Dim i As Integer, j As Integer, k As Integer Total = Cells(Rows.Count, 1).End(xlUp).Row TmCnt = 5 Data1 = Range("A1:A" & Total).Value ReDim Data2(1 To Total) Randomize For i = TmCnt To 1 Step -1 j = Int(Rnd * i) + 1 Data2(i) = Data1(j, 1) Data1(j, 1) = Data1(i, 1) Next i For i = Total To TmCnt + 1 Step -1 j = Int((i - (TmCnt + 1) + 1) * Rnd + TmCnt + 1) Data2(i) = Data1(j, 1) Data1(j, 1) = Data1(i, 1) Next i i = 1 Do For j = 1 To TmCnt k = k + 1 Cells(i, j + 2).Value = Data2(k) If k = Total Then Exit Sub Next j i = i + 1 Loop End Sub

  • エクセルのVBAで質問があります。

    現在自分はカレンダーを作成していて、カレンダーに祝日を入れたいと思っています そこで これを if文もしくはselectcase どっちを使ったら楽か教えてもらいたいです Sub MakeCalendar(hi As Date) Dim i As Integer 'カレンダーにセットする日付 Dim g As Integer '日付をセットする行番号 Dim r As Integer '日付をセットする列番号 Dim lastDay As Integer '作成するカレンダーの月末 g = 2 'その月の開始曜日を算出 r = Weekday(DateSerial(Year(hi), Month(hi), 1), vbSunday) '指定された日付の翌月1日をもとて、日付の前の日を計算する lastDay = Day(DateSerial(Year(hi), Month(hi) + 1, 1) - 1) For i = 1 To lastDay 'iに日付の設定 Cells(g, r).Value = i If r = 7 Then r = 1 '戻して g = g + 1 '1行下に書く Else r = r + 1 '1列→に移動する End If Next End Sub Sub test() Range("A2:G7").Value = "" 'A2~G2にカレンダー表示 MakeCalendar Range("I2").Value 'I2に日付を入力する End Sub Sub test() Range("A2:G7").Value = "" 'A2~G2にカレンダー表示 MakeCalendar Range("I2").Value 'I2に日付を入力する End Sub このようなマクロを組んでいまして、祝日(ゴールデンウィークなど)を赤で塗りつぶすような物を考えています。 VBAは初心者でまだあまりわかっていないので、ご教授ください