簡単にVBScriptの入力を行う方法【ステップバイステップ解説】

このQ&Aのポイント
  • VBAの記述を簡単にするために、Case文を使用して1から1000までの入力を行う方法を紹介します。
  • 具体的には、指定したセルの値を変数に代入し、Select Case文を使用して条件分岐します。
  • Case文の条件に合致した場合は、指定したシートの指定したセルに変数の値を代入します。
回答を見る
  • ベストアンサー

VBAの記述を簡単にする

下記のようなVBAを作成したいのですが、 Case "1"からCase "1000"まであると書き込みが大変です。 簡単に入力する方法を教えてください。 Sub 貼付() Dim x As Integer x = Worksheets("Sheet1").Range("B7") Select Case Range("A1") Case "1" Worksheets("Sheet2").Range("H2") = x Case "2" Worksheets("Sheet2").Range("H3") = x Case "3" Worksheets("Sheet2").Range("H4") = x Case "4" Worksheets("Sheet2").Range("H5") = x Case "5" Worksheets("Sheet2").Range("H6") = x Case "6" Worksheets("Sheet2").Range("H7") = x ・ ・ ・ Case "1000" Worksheets("Sheet2").Range("H1001") = x End Select End Sub

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

  • ベストアンサー
  • nattocurry
  • ベストアンサー率31% (587/1853)
回答No.1

Select Case Range("A1") Case "1" Worksheets("Sheet2").Range("H2") = x ・ ・ ・ Case "1000" Worksheets("Sheet2").Range("H1001") = x の部分を、 Worksheets("Sheet2").Range("H" & Range("A1") + 1) = x にしてみましょう。

masa2832
質問者

お礼

早々回答いただきありがとうございます。 早速使わせていただきました。入力時間が短縮でき、非常にたすかりました。

その他の回答 (2)

noname#140971
noname#140971
回答No.3

Sub XXXX()   Worksheets("Sheet2").Range("H" & Worksheets("Sheet1").Range("A1") + 1) = Worksheets("Sheet1").Range("A1") End Sub

masa2832
質問者

お礼

回答いただきありがとうございます。 勉強になりました。

  • FEX2053
  • ベストアンサー率37% (7987/21355)
回答No.2

確認してないですが、 ATAI = Cstr(Range("A1")) Worksheets("Sheet2").Range("H" & ATAI) = x xがうまく"ATAI"の変数に出来れば、SelectCaseを使わないでも こんな感じの式一発で行ける筈。

masa2832
質問者

お礼

色々な方法があるのですね、もっと勉強したいと思います。 ありがとうございました。

関連するQ&A

  • VBA 変数の使い方について

    皆様、こんばんは。 いつもお世話になっているVBAの初心者です。 今回、いくつかのテキストボックスの値を使った複雑な計算を行うために、変数を使おうとしていますが、うまく動いていません。 書こうとしているプロシージャはこちらです。 Private Sub 発電推計1() Dim My発電量1 As Integer Dim My発電量2 As Integer Dim My発電量3 As Integer Range("N37").Formula = "= (" & My発電量1 & " + " & My発電量2 & " + " & My発電量3 & ") * 10 / 10000" Select Case Range("O18") Case 1 My発電量1 = Range("P18") * 15 * 0.1 / 0.0036   ... End Select Select Case Range("O19") Case 1 My発電量2 = Range("P18") * 15 * 0.1 / 0.0036 ... End Select Select Case Range("O20") Case 1 My発電量3 = Range("P18") * 15 * 0.1 / 0.0036 ... End Select End Sub My発熱量の計算式に間違いがあるでしょうが、どう書けばいいかが分かりません。何方か詳しい方に教えていただければ非常に助かります。 どうぞよろしくお願いいたします。

  • VBAでVlookup関数を組もうとしていますがエラーが出ます。VBAに詳しい方、教えてください

    VBAでvlookup関数を下のように組みましたが、(1)でエラーが出ます。VBAに詳しい方、教えてください。 Sub VLLOKUPによる表の検索4() Dim mykensakuchi Dim mykensakuhan Dim gyo As Integer (1) mykensakuchi = Worksheets("sheet1").Range("a" & gyo).Value mykensakuhan = Worksheets("sheet2").Range("b2:e9") saikagyo = Worksheets("sheet1").Range("a" & Rows.Count).End(xlUp).Row gyo = 2 For gyo = saikagyo To 1 Step -1 With Application.WorksheetFunction Range("b:gyo").Value = .VLookup(mykensakuchi, mykensakuhan, 2, False) End With Next End Sub

  • ExcelのVBAについて(勉強中のです。)

    ExcelのVBAについて(勉強中のです。) ここからコード3以降に入力したコードを抜き出してデータ表を作成しそれを保存するコードを作成したいです。例えばCSV形式にするとか? データ表は1日分の表示で、保存して週間や月間または統計データまでを視野にいれています。今回は保存する所です。。 利用しやすい状態と保存形式で、よろしくお願いします。データは生活記録みたいなものです。何したどうしたどうなった? ※大分分岐する予定で、作成中であり、今回はコードの整理は不要です。 '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") End If Application.EnableEvents = False Application.EnableEvents = True Next time7 '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() ' ' 新規行挿入 ' ' Worksheets("Sheet2").Range("3:3").Insert Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select Dim se_r As String se_r = Application.InputBox("バーコードを入力してください") Select Case se_r Case "False" MsgBox "キャンセルされました" Case "" MsgBox "空欄が入力されました" Case Else Range("A3").Value = se_r End Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Dim Emp(1 To 300) As String Dim msg As String Dim i, i2, Cnt As Integer Dim N_In As Variant For i = 3 To 3 If IsEmpty(Cells(i, 1).Value) = False Then 'ここで空欄判定 Worksheets("Sheet1").Range("3:3").Insert '対象セルアドレスを改行処理 End If Next i '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") ws1.Activate End Sub

  • エクセル VBA

    A1,A2,A3→RAND()*99+1 B1→MAX(A1:A3) Sub test() Worksheets("sheet1").Calculate Dim x As Integer x = Range("B1") Range("C1").Value = x End Sub このように記述すると、B2とC2で結果が変わってしまうのですが、どうしてでしょうか?結果を同じにするにはどうすればいいですか?

  • エクセルVBA 1つのシートで出来ますか?

    説明が下手で申し訳ございませんが、宜しくお願い致します。 sheet(1)に20個のボタンがあります。 ボタンをクリックすると、別のシートが開きます。 開いたシートにも複数のボタンがあり、そのうちの任意のボタンをクリックすると、そのボタンの値がsheet(1)のそれぞれのボタンに対応したセルに入力される、という動作を実現したいと思っています。 現状、下記のようなコードで目的の動作は実現できてはいるのですが、各ボタンそれぞれにシートを作っているような状況です。(データ自体は全く同じ内容のものが、計20シート) たぶん、もの凄く頭の悪い事をやっているんだろうと思います。 sheet(1)を除いた各シートの入力データ自体は全く同じなので、シート一枚で出来るんじゃないのかなと思い、ネットや本で調べながら色々試してみたのですが、どうも上手く行きません。データが同じでも、sheet(1)のクリックしたボタンによって入力するセルを変えなければならないのが問題です。 sheet(1)のボタンとセルの関連付けや、sheet(1)のどのボタンを押したのかの判別ができればいいのかなと思って調べてみても、初心者にはよく理解できず、もう何週間もチャレンジしているのですがお手上げです。 上級者の方の知恵をお借りできれば幸いです。 Sub sheet2を開く() Worksheets(2).Select End Sub Sub 入力1() Worksheets(1).Range("F8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("F8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("F8") = "データ3" Worksheets(1).Select End Sub Sub sheet3を開く() Worksheets(3).Select End Sub Sub 入力1() Worksheets(1).Range("H8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("H8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("H8") = "データ3" Worksheets(1).Select End Sub Sub sheet4を開く() Worksheets(3).Select End Sub Sub 入力1() Worksheets(1).Range("M8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("M8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("M8") = "データ3" Worksheets(1).Select End Sub    ・    ・    ・    ・    ・

  • シートを増やすVBA

    フィルタで隠れている場合もある列の値を シート名として増やしていくVBAで以下のようなものをつくりました (値は重複している場合もある) 雛型シートがありそれをシート名だけ増やしていくというものです Sub シートを増やす() Dim target As Range Dim h As Range On Error Resume Next Set target = Worksheets("一覧シート").Range("E10:E" & Worksheets("一覧シート").Range("E65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible) If target Is Nothing Then Exit Sub 'シートを増やしていく For Each h In target On Error GoTo errhandle Worksheets(h.Value).Select On Error GoTo 0 Next Sheets("一覧シート").Select Exit Sub errhandle: Worksheets("雛型").Copy after:=Worksheets(Worksheets.Count) ActiveSheet.Name = h.Value Resume End Sub そうすると、実行エラー1004 ”シートの名前をほかのシート、Visual Basicで参照されるオブジェクトライブラリまたはワークシートと同じ名前に変更することはできません。” というエラーがたまにおきます(シート名が数字の場合におきるようです) 解決方法及び理由をご教授ください

  • VBA超初心者です。

    商品管理のためにVBAを利用しようとしているのですが、わからないことが多すぎでこまっています。   Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2007/12/1 ユーザー名 : 101 ' Dim meiend As Integer Dim code As Integer Sheets("商品名").Select Range("A4").Select Selection.End(xlDown).Select meiend = Selection.Row() For l = 4 To meiend Step 2 For r = 2 To 3 code = Cells(l, r).Value Select Case code Case 1 To 1999 sheet_neme = "1000" Case 1 To 1999 sheet_neme = "2000" Case 1 To 1999 sheet_neme = "3000" Case 1 To 1999 sheet_neme = "4000" Case 1 To 1999 sheet_neme = "5000" End Select Next Next End Sub  このように、商品番号がエクセル上の(B4、B5) (C4、C5)(D4,D5)(・・)(・・) というようにきさいされているのですが、(この順序は変更できないようになっています)VBAを使い商品番号が1000番台ならばシートの1000をセレクトし、2000番台ならばシート2000をセレクトするVBAを作りたいのですが、目的のシートに移動しません。 どなたか、お詳しい方教えていただけないでしょうか? かってですが、基本的な構文は変更せずにどこに問題があってシート移動しないのか教えていただければありがたいです。

  • VBAでFunctionの使い方

    エクセルのVBAでFunctionの使い方がいまいちよくわかりません。 Function msg() Dim h As Integer h = Hour(Time) Select Case h Case Is < 12: msg = "おはようございます。" Case Is < 17: msg = "こんにちは。" Case Else: msg = "こんばんは。" End Select End Function Sub 挨拶() MsgBox msg End Sub とやってみたら一応正しく動くようですが、これであっているのでしょうか? 他の例などを見るとFunction msg()の()内にも何か入れなければならないようなのですが、わかりません。

  • VBA超初心者です

    皆さんのお知恵を拝借させてください。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2007/12/1 ユーザー名 : 101 ' Dim pearend As Integer Dim code As Integer Dim codeend As Integer Dim sheet_name As String Dim dayend As Date Sheets("商品名").Select Range("A4").Select Selection.End(xlDown).Select pearend = Selection.Row() For l = 4 To pearend Step 2 For r = 2 To 3 Cells(l, r).Select code = Cells(l, r).Value Select Case code Case 1000 To 1999 sheet_name = "1000" Case 2000 To 2999 sheet_name = "2000" Case 3000 To 3999 ssheet_name = "3000" Case 4000 To 4999 sheet_name = "4000" Case 5000 To 5999 sheet_name = "5000" End Select Sheets(sheet_name).Select Range("B4").Select Selection.End(xlToRight).Select codeend = Selection.Column() Range("A5").Select Selection.End(xlDown).Select dayend = Selection.Row() For i = 2 To codeend If code = Cells(4, i).Value Then Range(Cells(dayend, i), Cells(5, i)).Select Selection.Copy Sheets("商品名").Select Range("K3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next Next Next End Sub というマクロをつくってみたのですが、何順目かあたりから For r = 2 To 3 のrがなぜか4になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。

  • VBAで教えて下さい。

    VBA初心者です。始めてから2,3週間です。 表を作りたいのですが、 顧客名のシートを100枚ほど作り、シート1(シート1は検索シートにしたいので顧客名は無)のA1にクライアント名を入力したら入力した顧客名シートが出てくる様にしたいです。 参考書、ネット等をみて作成しましたがエラーが出ます。作動するにはどの様にしたら宜しいでしょうか?どうかお助け下さい。宜しくお願い致します。コードは下記です。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer Dim myWSname As String, myworksheet As Worksheet myWSname = "i" myWSname = Worksheets("sheet2").Range("A1").Value For Each myworksheet In Worksheets If myworksheet.Name = mayWSname Then Worksheets("myWSname").Activate Exit Sub End If Next myworksheet End Sub

専門家に質問してみよう