• ベストアンサー
  • すぐに回答を!

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) 宜しくお願いします。

共感・応援の気持ちを伝えよう!

  • 回答数2
  • 閲覧数67
  • ありがとう数2

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

  • ベストアンサー
  • 回答No.2
  • kkkkkm
  • ベストアンサー率58% (883/1513)

No1の追加です。 また、数値かどうかやチーム数の最低数以上の値かどうかは判定したほうがいいと思います。 3チーム以上とかにするならたとえば If IsNumeric(Range("B1").Value) And Range("B1").Value > 2 Then TmCnt = Range("B1").Value Else MsgBox "入力に不備があります", vbCritical End If

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ありがとうございます。 最低数以上の値ですか?気付きませんでした。

関連するQ&A

  • 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 リーダーを選出したチーム分け

    名簿を作り、その名前をランダムでチームに分けるようにしたいです。 検索して以下のような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番目に配置する方法はどうしたら良いでしょうか? 宜しくお願いします。

  • シード権を省いたヒートランダム分け

    A1は名前が並んでいます。 B1はシード権取得の名前です。 C1はA1セルの人数に合わせてヒート分けする数を入力します。1つのヒートに4名前後です。 Dセル以降はシード権を省いたヒート分けします。 下記はA1セルからランダムにヒート分けしたプログラムです。 シード権を省いたヒートランダム分けをするにはどうしたら良いでしょうか? 宜しくお願いします。 Sub heatrandom() Dim Total As Integer Dim TableCnt As Integer Dim Data1 As Variant Dim Data2() As String Dim i As Integer, j As Integer, k As Integer Dim FirstRow As Long, LastRow As Long FirstRow = 2 LastRow = Cells(Rows.Count, 1).End(xlUp).Row Total = LastRow - FirstRow + 1 TableCnt = Range("B2").Value Data1 = Range(Cells(FirstRow, 1), Cells(LastRow, 1)).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 TableCnt k = k + 1 Cells(i, j + 2).Value = Data2(k) If k = Total Then Exit Sub Next j i = i + 1 Loop End Sub

その他の回答 (1)

  • 回答No.1
  • kkkkkm
  • ベストアンサー率58% (883/1513)

そのまま TmCnt = Range(“B1”).Value でいいと思いますよ。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

コメントありがとうございます。 おかげさまでうまくいきました。

関連するQ&A

  • EXCEL VBA 配列変数の値すべてを返すには

    EXCELは2002ですが、97でも動くと嬉しいです。 《質問》 1~10をランダムに並べるためのプログラムを書きました。 これはこれで動くのですが、一行(3行目)だではなく 4行目にも、5行目にも同じことをしたい場合、 バブルソートの部分をサブルーチン(関数)にしたいのですが X_v() = GetSortArray(n_s,n_v)()とはできません。.cloneもだめですよね。 かといって、要素毎に引くとその度にRndが効いて、1~10が並びません。 どのようにやるのが、スマートなのでしょうか?よろしくお願いします。 《以下プログラム》 Sub Bu_Click() Dim i As Integer Dim j As Integer Const n_e = 10 Const n_s = 1 Dim X_r(n_e) As Long Dim X_v(n_e) As Long Dim temp1 As Long Dim temp2 As Integer Randomize For i = n_s To n_e X_r(i) = Int(Rnd * 10 ^ 9) X_v(i) = i Next i For i = n_s To n_e - 1 For j = n_s To n_e - 1 If X_r(j + 1) < X_r(j) Then temp1 = X_r(j + 1) X_r(j + 1) = X_r(j) X_r(j) = temp1 temp2 = X_v(j + 1) X_v(j + 1) = X_v(j) X_v(j) = temp2 End If Next j Next i For i = 0 To n_e - 1 Cells(3, 3 + i).Value = X_v(i + 1) Next i End Sub Public Function GetSortArray(s As Integer, e As Integer) As Long() Dim r() As Long Dim v() As Long Dim temp1 As Long Dim temp2 As Integer ReDim r(e) ReDim v(e) Randomize For i = s To e r(i) = Int(Rnd * 10 ^ 9) v(i) = i Next i For i = s To e - 1 For j = s To e - 1 If r(j + 1) < r(j) Then temp1 = r(j + 1) r(j + 1) = r(j) r(j) = temp1 temp2 = v(j + 1) v(j + 1) = v(j) v(j) = temp2 End If Next j Next i GetSortArray = v() End Function ありゃ?Tabのスペース消えますね。

  • VBA 選択された離れたセルの値の取得について

    EXCELのVBAでどうしても前に進めず困っております。 目的としているコードは、離れたセル(複数)をあらかじめCtrlキーで選択状態にしておき、選択されたセルの値のみをVBAが別のセルに並べていくというものです。 以下が私の作ったコードなのですが、思ったとおりの動作をしてくれません。 VBA初心者なもので、おかしな記述がたくさんあると思うのですが、どなたかアドバイスお願いします。 Public Sub xx() Dim SelectArea As String Dim TargetCell As Range Dim a As Integer Dim Row As Integer Dim Column As Integer Dim CNT1 As Integer a = 0 Row = 0 Column = 0 For CNT1 = 1 To 10 Row = Row + 1 SelectArea = Selection.Address Set TargetCell = Range("B3").Cells(Row - 1, Column) If Intersect(Range(SelectArea), TargetCell) Is Nothing Then Else Range("A30").Cells(a, 0) = Range("B3").Cells(Row - 1, Column).Value a = a + 1 End If Next End Sub

  • Excel VBA のFor Each ・・・ Next について

    配列に数字(特段数字でなくても)入れたいのですが、以下のように書きました。 Sub test() Dim x As Variant Dim m(1 To 10) As Integer For Each x In m x.Value = 100 Next Stop End Sub Stopでとめてmを確認するとすべて0です。どうしてなのでしょうか。 配列ではなく Sub test() Dim x As Variant For Each x In range("a1:a10") x.Value = 100 Next End Sub とするとA1:A10には100が入ります。 この差がいまいちわからなくて、 もちろんFor ・・・ Nextで簡単に入れられるのは承知しています。 補足ですが また最初はx.valueの.valueをつけていなかったのでセルにも反映されませんでしたが.valueをつけると入りました。

  • VBAでF(I) = 1# / Exp(TT)の値がセルに0と表示され

    VBAでF(I) = 1# / Exp(TT)の値がセルに0と表示されてしまう問題があります。 TTやExp(TT)の値はそれなりの数値がでるのですが、F(I) だけが0となってしまいます。 どうのようにすれば正しくひょうじされるでしょうか? また、CDblの位置は下記の場所であっているのでしょうか? 以上ご回答よろしくお願いします。 Private Sub CommandButton1_Click() Dim X(500) As Double Dim Y(500) As Double Dim F(500) As Double Dim FI(500) As Double Dim N As Integer Dim DX As Double Const Pi = 3.141592654 Dim I As Integer Dim TT As Double N = Range("_N") DX = Range("_DX") '-----------------------<データを自動生成している。ここから F(1) = 0.5 For I = 2 To N TT = DX * CDbl(I - 1) F(I) = 1# / Exp(TT) Next I '-----------------------<データを自動生成している。ここまで Worksheets("Sheet1").Range("E4:E30").Value = TT Worksheets("Sheet1").Range("F4:F30").Value = Exp(TT) Worksheets("Sheet1").Range("G4:G30").Value = F(I) End Sub

  • VBAでの質問

    お世話になります。 下記の記述で、「←」の矢印の記述で、 Cells.(5,2)がブランクでなければ、 「→」から進めたいのですが、 どの様に記述すれば宜しいでしょうか ご教示お願いします。 Sub 表記入() Dim Data As Range Dim i As Integer Dim j As Integer Dim k As Integer Set Data = Sheets("集計").Range("A2").CurrentRegion j = 16 k = 0 With Sheets("表") For i = 3 To Data.Rows.Count If Data.Cells(i, 51) <> "" Then .Cells(5, 2) = Data.Cells(i, 3)  ← .Cells(5, 7) = Data.Cells(i, 4) → .Cells(j, 2) = Data.Cells(i, 10) .Cells(j, 6) = Data.Cells(i, 11) & Data.Cells(i, 12) .Cells(j, 14) = Data.Cells(i, 51) Else End If k = k + 1 If k = 10 Then j = j + 18 k = 0 Else j = j + 1 End If End If Next i End With End Sub

  • VBAで変数の値をセルに表示させる

    VBAで変数の値をセルに表示させる プログラム初級者です。 配列変数を使わずに 例えば、変数a1,a2・・・a10 の10個の変数を使ってセルにその値を表示する場合に a1,a2・・・a10をfor next を使って、省略化するにはどうすればよいでしょうか? 具体的には例えば、(私が書いたのは) Sub aaa() Dim a1,a2,a3,a4,a5,a6,a7,a8,a9,a10 as Integer Dim i as Integer a1=1 a2=2 a3=3 a4=4 a5=5 a6=6 a7=7 a8=8 a9=9 a10=10 For i = 1 to 10 ax= "a" & str(i) Cells(i, 1).value = ax Next End sub() 結果は a 1 a 2 a 3 a 4 a 5 a 6 a 7 a 8 a 9 a 10 と表示されました。 a1と文字列をとってそれを変数と見なしさらにその変数の値を表示させたいのです。 ちなみにaxの値はa 1 とaと1の間に半角スペースが入ってしまいます。 どうすればいいか行き詰まっています。 解決方法はあるでしょうか?

  • セルの値でなくセルの関数を参照したい

    次のコードでセルI13の値を入力できましたが、 '---------------------- 'Dim i As Integer 'For i = 2 To Worksheets.Count - 6 'With Worksheets(i) '.Range("I13") = Worksheets(1).Range("I13").Value 'End With 'Next セルの値でなく関数を入力しようとして次のコードに修正したらエラーになりました。どこがいけないのでしょうか。 Dim i As Integer For i = 2 To Worksheets.Count - 6 With Worksheets(i) .Range("I13").Formula = "=" & Worksheets(1).Name & "!I13" End With Next

  • エクセルVBAで配列?

    以下は、文字列"t", "e", "s", "t"を配列に取り込み、セルに表示する例ですが、 ar = Array("t", "e", "s", "t") なら作動しますが、セル範囲から取り込もうと、 ar = Range("A1:D1").Value とするとエラーになります。 どうしてでしょうか? Sub test() Dim ar As Variant Dim n As Integer ar = Array("t", "e", "s", "t") 'ar = Range("A1:D1").Value For n = LBound(ar) To UBound(ar) Cells(n + 1, 5) = ar(n) Next n End Sub

  • VBA 値、セル操作

    お世話になります [現状] 実行させると 1列目を残して2列づつ処理をさせています Sub Macro1() Dim idxR, idxC, ptr As Integer Dim ws As Worksheet Set ws = ActiveSheet Worksheets.Add after:=ws ptr = 2 With ws .Rows(1).Copy Destination:=Range("A1") For idxR = 2 To .Range("A65536").End(xlUp).Row Cells(ptr, "A").Value = .Cells(idxR, "A").Value For idxC = 2 To 255 Step 2 If .Cells(idxR, idxC) = "" Then Exit For Else .Cells(idxR, idxC).Resize(1, 2).Copy Destination:=Cells(ptr, "B") ptr = ptr + 1 End If Next idxC Next idxR End With End Sub [判らないこと] 前7列を残して(A:G) 8列目から(H列)より9列づつ処理をさせたいのですが判らなく大変困っております。 どなたかご教授よろしくお願いします。

  • 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