• ベストアンサー

エクセルＶＢＡ　参照するシートを　変数化

早速ですが 参照するシートを　変数化して、冒頭で　宣言したいのですが datasheet1="2012" If Format(datasheet1.Cells(cnt, 2), "hh:mm:ss") = Format("9:00:00", "hh:mm:ss") Then この様な扱い方なんですが Dim datasheet1 As Object　とやってもダメでした。 よろしくどうぞ

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

  • ベストアンサー
  • LancerVII
  • ベストアンサー率51% (1060/2054)
回答No.1

こんにちは。 Dim sheetname As String sheetname = "2012" Dim sheet1 As Worksheet Set sheet1 = Worksheets(sheetname) これでsheet1には2012という名前のシートが入ります。 あとはsheet1.Range("A1")等でアクセスできるようになります。

007itochan
質問者

お礼

早速　ありがとうございます。 理解しました

その他の回答 (1)

  • nak777r
  • ベストアンサー率36% (49/136)
回答No.2

ソースの頭で Public Property Get datasheet1() As Worksheet Set datasheet1 = Application.ThisWorkbook.Worksheets("2012") End Property とプロパティ化して記載しておけば 以降、どの関数でもそのまま使えます。 Public Sub test() If Format(datasheet1.Cells(cnt, 2), "hh:mm:ss") = Format("9:00:00", "hh:mm:ss") Then End If End Sub Public Sub test2() If Format(datasheet1.Cells(cnt, 2), "hh:mm:ss") = Format("10:00:00", "hh:mm:ss") Then End If End Sub

007itochan
質問者

お礼

ありがとうございます。 恐縮ですが、早い方、ベストということにてご容赦のほど

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • エクセルVBAでシートモジュールでのパブリック変数

    エクセル2000です。 標準モジュールで取得したパブリック変数は他のシートモジュールで参照できますが、逆にシートモジュールで取得したパブリック変数は他のシートで参照できないのでしょうか？ シートチェンジイベントで取得した文字列を変数nmに格納し、ワークブックモジュールで呼び出そうとしたら何もでてきませんでした。 どうやったらよいのでしょうか？ 'シートモジュールの記述 Public nm As String Private Sub Worksheet_Change(ByVal Target As Range) Dim rw As Integer If Intersect(Target, Range("A1").CurrentRegion) Is Nothing Then Exit Sub If Selection.Count > 1 Then Exit Sub rw = Target.Row nm = IIf(Cells(rw, "A") = "", Cells(rw, "A").End(xlUp).Value, Cells(rw, "A").Value) 'MsgBox nm End Sub 'ThisWorkbookモジュールの記述 Private Sub Workbook_BeforeClose(Cancel As Boolean) If nm = "" Then Exit Sub MsgBox nm & "さん、ご苦労様でした。" End Sub

  • VBS【特定のレコード長で件数取得】

    お世話になります。 下記VBSコードですが、あるファイルを特定のレコード長（340で1行）で割って件数を取得したいのですが、 どこを改良すればよいでしょうか？ ------------------------------------------------------------- Option Explicit '********オブジェクト変数定義******** Dim FSO , f '********カウント変数宣言************ Dim CNT '********フォルダ変数宣言************ Dim TARGET_FOLDER '********ファイル変数宣言************ Dim TARGET_FILE , TARGET_FILENAME '********レコード長変数宣言************ Dim FILE_LENGTH '********時間変数定義******** Dim YYYYMMDD , HHMMSS , HH , MM , SS YYYYMMDD = Year(Date) * 10000 + MONTH(Date) * 100 + DAY(Date) HH = Hour(Time) MM = Minute(Time) SS = Second(Time) If MM < 10 then MM = "0" & MM End If If SS < 10 then SS = "0" & SS End If HHMMSS = HH & ":" & MM & ":" & SS '********その他変数定義******** Dim FILE_SIZE , FILE_DAY '初期設定 TARGET_FOLDER = "D:\test" TARGET_FILE = "test" TARGET_FILENAME = TARGET_FOLDER & "\" & TARGET_FILE FILE_LENGTH = 340 CNT = 0 'ファイルサイズ・ファイル更新日時取得処理 Set FSO = CreateObject("Scripting.FileSystemObject") Set f = FSO.GetFile(TARGET_FILENAME) FILE_SIZE = f.size FILE_DAY = f.DateLastModified 'レコード件数取得処理 With FSO.GetFile(TARGET_FILENAME).OpenAsTextStream(8) CNT = .Line .Close Msgbox CNT Msgbox FILE_SIZE Msgbox FILE_DAY End With ------------------------------------------------------------- 上記だとCNTはあくまで1改行につき1件でカウントしています。 ご存知の方がいらっしゃいましたら、お知恵を拝借させていただけませんでしょうか？ 何卒宜しくお願い致します。

  • エクセル　VBA　タイマー　0：00：00で

    ５分ピッチで　仕事させます。 ブックオープンで インターバル = TimeValue("00:05:00") Application.OnTime Format(開始時刻, "hh:mm:ss"), "orgdata.必要な作業を行うマクロ", 待ち時間 Debug.Print "st" & 開始時刻 Call timer_set 反復時刻 = 開始時刻 If Format(反復時刻, "hh:mm:ss") > "23:54:00" Then 反復時刻 = Format(DateAdd("d", 1, 反復時刻), "yyyy/mm/dd") & " " & TimeValue("0:00:10") Else 反復時刻 = Format(反復時刻, "yyyy/mm/dd") & " " & TimeValue(反復時刻) + インターバル End If ループで５回ほど Application.OnTime Format(反復時刻, "hh:mm:ss"), "orgdata.必要な作業を行うマクロ", 待ち時間 Debug.Print "loopexit" & 反復時刻 で、デバッグアウトが end　2013/08/15 3:02:00 st　2013/08/14 23:50:10 loop2013/08/14 23:55:10 loop2013/08/15 00:00:10 loop2013/08/15 00:05:10 loop2013/08/15 00:10:10 loopexit2013/08/15 00:15:10 makuro 2013/08/15 00:20:10 makuro 2013/08/15 00:25:10 makuro 2013/08/15 00:30:10 で、「必要な作業を行うマクロ」　で　仕事のあと　タイマー追加します。 If Format(反復時刻, "hh:mm:ss") > "23:54:00" Then 反復時刻 = Format(DateAdd("d", 1, 反復時刻), "yyyy/mm/dd") & " " & TimeValue("0:00:10") Else 反復時刻 = Format(反復時刻, "yyyy/mm/dd") & " " & TimeValue(反復時刻) + インターバル ' End If Application.OnTime Format(反復時刻, "hh:mm:ss"), "必要な作業を行うマクロ", 待ち時間 （反復時刻を　時間だけの時　formatを　入れて・・・） Debug.Print "makuro " & 反復時刻　’これが　デバッグで出力されています。 で、ダミーの作業が clup = clup + 1 orgdata.Cells(clup, 10) = Format(Now, "yyyy/mm/dd") orgdata.Cells(clup, 11) = Format(Now, "hh:mm:ss") orgdata.Cells(clup, 12) = Format(反復時刻, "yyyy/mm/dd") orgdata.Cells(clup, 13) = Format(反復時刻, "hh:mm:ss") 結果 2013/8/14 23:50:10 2013/8/15 0:20:10 2013/8/14 23:55:10 2013/8/15 0:25:10 2013/8/15 0:00:10 2013/8/15 0:30:10 これで、タイマー作業が　途切れます。 0：00：00　超える事に　問題があるなら　0：00：10　は　実行されないハズ・・・・ 反復時刻は　ｙｙｙｙ/ｍｍ/ｄｄ　&　”　”　&　”ｈｈ：ｍｍ：ｓｓ”　です。 試しに　時刻だけでやっても　同じでした。 さて、如何でしょ？ 実は　これで、動いていたのですが、３日ほど前から　0：00以降　突然タイマーが動かなくなったのです ＰＣは　３台　同じ現象です　よって　ＷＩＮの設定では無い・ エクセル　オプションに　何か設定でもあるのか？？ どうも　VBAのタイマーは不可解で エクセル終了させず、　プログラムだけ終了、再ロードだと、前のタイマー残ったまま、ダブルでタイマー動くとか・・・・ それと、WIN32とかの　別のタイマー使った方が　良いのでしょうか？？

  • エクセルVBAで

    登録ボタンを作りたいのですが うまくいきません。 応答無しになってしまいます。 仕事でコードを入力して、住所やその他の関連事項を 登録して、検索し、封筒に宛名印刷し、登録内容の修正をしたいと思っています。 登録ボタンは下記のようなものを作りました。 Private Sub CommandButton1_Click() Dim bk As Workbook Dim sh1 As Worksheet Dim sh2 As Worksheet Dim cnt1 As Long Set bk = ThisWorkbook Set sh1 = bk.Worksheets("現場登録検索") Set sh2 = bk.Worksheets("一覧") cnt1 = 6 Do While sh2.Cells(cnt1, 2).Value <> "" cnt = cnt1 + 1 Loop '得意先CD sh2.Cells(cnt1, 2).Value = sh1.Cells(2, 3).Value '現場CD sh2.Cells(cnt1, 3).Value = sh1.Cells(3, 3).Value '送り方 sh2.Cells(cnt1, 22).Value = sh1.Cells(4, 3).Value '封筒 sh2.Cells(cnt1, 23).Value = sh1.Cells(5, 3).Value MsgBox "登録できました。" End Sub 何が悪いのでしょうか? よろしくお願い致します。

  • VBAのファイル参照について

    セルの変更時、列によって行の内容を変更するプログラムを組んだのですが、 エラーが起きてうまくいきません。 使用しているExcelは2007です。 ファイルを参照するあたりが全然わかってないのでそのあたりがあやしいです。 実行時エラー '91': オブジェクト変数または With ブロック変数が設定されていません。 → hoge = book1.Worksheets(customer).Range("A34:D" & endrow) '係数表をコピー ↓デバッグ押すと 実行時エラー '-2147417848 (80010108)': 'Value' メソッドは失敗しました: 'Range'オブジェクト → Call all_feeCulc_change2(target.Parent.Name, target.row) 番号をメモし忘れました。91かこれが表示されます。どちらが出るかわかりません。 'Range' メソッドは失敗しました:'_Worksheet' オブジェクト →endrow = book1.Worksheets(customer).Cells(Rows.Count, 1).End(xlUp).row '最終行番号を取得 何回かリトライして開いたり閉じたりを繰り返したら↓のようなダイアログも出ました。 マクロでスタック領域が不足しています また、ダイアログで終了を押したらセルを正しく選択できなくなりました。 デバッグを押したら、停止ボタンを押すと応答なしになった後、Excelが終了し再起動しました。 そして、どちらを選択した場合でも、メニューや閉じるボタンを押してもExcelが終了できず、 タスクマネージャからプロセスを終了させるしかなかったです。 その時CPU使用率が50%を超えてたりと異常事態になっております。 ###標準モジュール### Sub all_feeCulc_change2(ByVal sheetName As String, ByVal row As Integer) If sheetName <> "" Then Dim customer As String customer = Worksheets(sheetName).Cells(row, 3) On Error Resume Next Dim book1 As Workbook '別ファイルのオープン（触らない） Workbooks.Open Filename:="hogehoge.xlsm" '別ファイルのオープン（触らない） Set book1 = Workbooks("hogehoge.xlsm") '別ファイルのオープン（触らない） On Error GoTo 0 Dim endrow As Integer '最終行番号 endrow = book1.Worksheets(customer).Cells(Rows.Count, 1).End(xlUp).row '最終行番号を取得 Dim hoge As Variant hoge = book1.Worksheets(customer).Range("A34:D" & endrow) '早見表から係数表をコピー With Worksheets(sheetName) ... ###ThisWorkbook### Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range) If target.Count = 1 Then Dim column As Integer Dim row As Integer column = target.column row = target.row If row >= 3 Then If ((column - 3) Mod 5) = 2 And column > 3 Then '更新セルがメーターだったら Call usageCulc_change(target.Parent.Name, target.column, target.row) Call all_feeCulc_change(target.Parent.Name, target.column - 1, target.row) Call chenge_tax_change(target.Parent.Name, target.column + 1, target.row) ElseIf column = 3 Then target.Value = format(target.Value, "000") '誤入力防止 Call all_feeCulc_change2(target.Parent.Name, target.row) Call chenge_tax_change2(target.Parent.Name, target.row) End If End If End If End Sub Private Sub Workbook_Open() '*****すべてのシート名を取得*****' Dim ws As Worksheet Dim sheetName() As String ReDim sheetName(3) Dim cnt As Integer cnt = 0 For Each ws In Worksheets If cnt > 3 And (cnt Mod 4) = 0 Then ReDim Preserve sheetName(UBound(sheetName) + 4) End If sheetName(cnt) = ws.Name cnt = cnt + 1 Next '*****取得終了*****' Dim endrow As Integer Dim line As Variant For Each line In sheetName If line <> "000" And line <> "" Then With Worksheets(line) endrow = .Cells(Rows.Count, 3).End(xlUp).row Dim i As Integer Dim j As Integer For i = 0 To endrow For j = 0 To 11 .Cells(3 + i, 4 + j * 5).NumberFormatLocal = "0.0" .Cells(3 + i, 5 + j * 5).NumberFormatLocal = "0.0" .Cells(3 + i, 6 + j * 5).NumberFormatLocal = "#,##0" .Cells(3 + i, 7 + j * 5).NumberFormatLocal = "#,##0" .Cells(3 + i, 8 + j * 5).NumberFormatLocal = "#,##0" Next j Next i End With End If Next End Sub

  • excel　日付で、０時が読み出せない

    エクセルのセルにyyyy/mm/dd hh:mm:ssの形式で日付と時間を入れている。これを エクセルVBAで Dim W as String W=Cellｓ（） で読み出したとき、０時の場合、Wには時間以降が無くなっている。 日付のフォーマットはこのままで、０時の時も0:00:00の部分が読み出せないでしょうか。 なお、Cells().Valueとしても同じです。 また、日付以外のデータも読み込む可能性が有ります。

  • VBA 時間の抜き出しが上手く処理できない

    時間の抜き出しをするのに下記のコードを候補に挙げましたが、 「'コロンが2個の場合　（時：分：秒）」の場合は上手く処理できますが 「'コロンが1個の場合　（分：秒）」の数値が上手く処理できません。 ’----------------------------------------------------------------------- Option Explicit Sub コロンの数を数える() Dim i As Long, cnt As Long, n As Variant For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row cnt = 0 '←cntをリセット Do n = InStr(n + 1, Cells(i, "A"), ":") If n = 0 Then Exit Do Else cnt = cnt + 1 End If Loop If cnt < 1 Then MsgBox "[:]がありません。" '←cntが1未満のときにメッセージを発出します。 End Else Cells(i, "B").Value = cnt End If Next End Sub Sub 時間抜き出し() Dim i As Long, cnt As Long Dim n As Single For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row n = InStr(n + 1, Cells(i, "A"), ":") 'コロン「:」の位置を特定する If Cells(i, "B") = 1 Then 'コロンが1個の場合　（分：秒） Cells(i, "C").NumberFormatLocal = "h:mm:ss" If Mid(Cells(i, "A"), n - 2, 1) = " " Or Mid(Cells(i, "A"), n - 2, 1) = "(" Then '10分以下の場合 Cells(i, "C") = Mid(Cells(i, "A"), n - 1, 4) Cells(i, "C") = "0:" & Cells(i, "C") Else '10分以上 Cells(i, "C") = Mid(Cells(i, "A"), n - 2, 5) Cells(i, "C") = "0:" & Cells(i, "C") End If Else 'コロンが2個の場合　（時：分：秒） Cells(i, "C").NumberFormatLocal = "h:mm:ss" Cells(i, "c") = Mid(Cells(i, "A"), n - 1, 7) End If n = 0 Next End Sub

  • ExcelのVBAについてです。シート1と2を作成

    ExcelのVBAについてです。シート1と2を作成し、シート1にバーコードまたはキーボードで入力します。シート1は入力専用かつ入力した分の早見表で、実際にはシート2に転記仕訳して、シート3以降に表を作成したいです。使い方はシート1に入力またはシート2をタップまたはクリックすると入力(画面)になります。以前の質問の回答を参考に必要最低限に改良しています。パッと見で構いません、何か不具合は見付からないでしょうか？ '///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 '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Dim st1, s, i3 As Long Dim Bst As Range Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 st1 = ws1.Cells(Rows.Count, "E").End(xlUp).Row 'A列の最終行を設定する s = 3 For i3 = 3 To st1 Set Bst = ws2.Columns("E").Find(What:=ws1.Cells(i3, "E"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) シート間のE列を比較 If Bst Is Nothing Then '比較して無い場合は、下記を実行 ws1.Cells(s, "A") = ws1.Cells(i3, "A") '追加する文字を転記する。（コード） s = s + 1 End If Next i3 Next i '(1)シートを変数にセット Dim ws1_ As Worksheet Set ws1_ = Worksheets("Sheet1") ws1_.Activate End Sub

  • ワークシート名を変数に格納する方法

    VBA初心者です。ワークシートが5つあり各シートにデータを転記するマクロを作成したいのですがワークシート名を変数にしてループ処理することはできるのでしょうか？ 下記はワークシート名"H"にだけ転記するマクロを作成してみましたがこの後がわからず悩んでいます。よろしくお願いします。 Dim データ行 As Integer Dim cnt As Integer Dim データ数 As Integer cnt = 4 データ行 = Cells(Rows.Count, 8).End(xlUp).Row For データ数 = 11 To データ行 　 If Worksheets("入力").Cells(データ数,1).Value= "2"Then Worksheets("H").Cells(cnt, 6).Value = Worksheets("入力").Cells(データ数, 8).Value Worksheets("H").Cells(cnt, 7).Value = Worksheets("入力").Cells(データ数, 9).Value Worksheets("H").Cells(cnt, 8).Value = Worksheets("入力").Cells(データ数, 27).Value Worksheets("H").Cells(cnt, 9).Value = Worksheets("入力").Cells(データ数, 19).Value Worksheets("H").Cells(cnt, 10).Value = Worksheets("入力").Cells(データ数, 20).Value Worksheets("H").Cells(cnt, 11).Value = Worksheets("入力").Cells(データ数, 21).Value Worksheets("H").Cells(cnt, 12).Value = Worksheets("入力").Cells(データ数, 10).Value Worksheets("H").Cells(cnt, 13).Value = Worksheets("入力").Cells(データ数, 11).Value Worksheets("H").Cells(cnt, 14).Value = Worksheets("入力").Cells(データ数, 22).Value Worksheets("H").Cells(cnt, 15).Value = Worksheets("入力").Cells(データ数, 23).Value cnt = cnt + 1 End If Next データ数

  • (VBA)Splitの抜き出しが上手くいかない

    以下のようなコードで「指定区切り文字」の前後で文字列を切り出しています。 添付画像見てもらえれば判ると思いますが B8セルからのB列の値が「29:08」が正解なのに 「29:08:00」と最後に「:00」が付いた形式になっています。 （B13で1時間を過ぎると正常になっています。） このため、以後のE及びF列の書き出しもおかしな値となりました。 どのように修正すれば良いでしょうか　？ Option Explicit Sub Chapter_Plus() Dim I As Long Dim J As Long Dim TEMP As Variant Dim SepChr As String Dim WS1 As Worksheet Dim WS2 As Worksheet Dim EndLow As Long Dim LineData As String Dim OutText As String Dim byteData() As Byte '一時格納用 Set WS1 = Worksheets("DATA") Set WS2 = Worksheets("Chapter") 'シートの初期化 WS1.Range("B3:H100").Clear WS2.Range("A1:A100").Clear SepChr = InputBox("指定文字を入力してください。", "区切り文字入力", " ") 'TotalLength = InputBox("時間を(h:mm:ss)で入力してください。", "ファイルサイズ入力") EndLow = WS1.Cells(Rows.Count, "A").End(xlUp).Row With WS1 '区切り文字で切り出す For I = 3 To EndLow TEMP = Split(.Cells(I, "A"), SepChr) .Cells(I, "B") = TEMP(0) .Cells(I, "C") = TEMP(1) Next '仮チャプター書き出す For I = 3 To EndLow .Cells(I, "E").Value = Format(.Cells(I, "B").Value, "hh:mm:ss") .Cells(I, "F").Value = Format(.Cells(I + 1, "B").Value, "hh:mm:ss") .Cells(I, "G").Value = .Cells(I, "C").Value Next '番号 For I = 3 To EndLow .Cells(I, "H").Value = CStr(Format(I - 2, "'00")) Next End With End SUB

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する