• ベストアンサー

INPUT関数で入力した日付でワークシートとセルに値をいれる。

こんにちは、最近VBAを勉強し始めたのですが、 躓いてしまいました。 すでにあるワークシートからINPUT関数で”20101016”を入力して ワークシートをコピー(シート名は”20101016”)する事はできたのですが このシートに”2010年 10月 16日 (曜日)”を表示する事ができないのです。 指定したセルには”20101016”が入っているのですが 表示が"###################”になってしまいます。 (”負の日付又は時間は###の表示になります。”の意味がわかりません。) 書式設定で日付等をいじっても変化がありません。 どなたか、ご教示願います。 Sub 新規シート() Dim tuki As String ActiveSheet.Copy after:=ActiveSheet   'アクティブシートの後ろへコピーを作る。 Range("a46:r57").Select   'コピー元の値を削除 Selection.ClearContents Range("a1").Select tuki = InputBox("日付を半角英数字で入力してください。" & Chr(13) & _ "yyyymmdd 形式で入れてね!", "日付入力")   'tukiに8桁を入力 If tuki = "" Then Application.DisplayAlerts = False ActiveSheet.Delete Application.DisplayAlerts = True   '入力が無い場合、作成したシートを削除 Else On Error Resume Next ActiveSheet.Name = tuki   '新規ワークシート名に”tuki”を代入 Range("d6").Value = tuki  ’ここが問題! If Err.Number = 1004 Then MsgBox "日付が重複しています。" Application.DisplayAlerts = False ActiveSheet.Delete Application.DisplayAlerts = True   'シート名が重複した場合、警告後に削除 End If End If End Sub

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

  • ベストアンサー
  • hige_082
  • ベストアンサー率50% (379/747)
回答No.2

>Range("d6").Value = tuki  ’ここが問題!   ↓ Range("d6").Value = Left(tuki, 4) & "/" & Mid(tuki, 5, 2) & "/" & Right(tuki, 2) ”20101016”は日付じゃないよね "2010/10/16"が日付だよ 日付にしたければ、日付にしなきゃ

nabepapa
質問者

お礼

ご返事ありがとうございます。 LEFT、MID、RIGHT関数は以前使ったことがあったので思い出しながら 実行してみました。 問題なく動作することが確認できました。 頂いたコードに&”日”を追加して表示させ、曜日は=TEXT(D6,"(aaa)")で対応しました。 ご教授、ありがとうございました。

その他の回答 (1)

回答No.1

tukiの内容が"2010/10/16"などExcelが日付だろうと思い込む文字 列ならよかったんですが、間違ってExcelが数値だろうと思い込む 20101016を入れちゃったんですね。 Excelは基準とする日(前世紀初頭)からの経過日数で日付を扱い、 その最大値は西暦9999年末です。数値で書くと296万弱ってところ ですね。そこに2010万ちょいの数値を入れて「日付で表せ」と言わ れても無理、範囲外だからとエラー表示になります。 入力する文字列を考え直してください。

nabepapa
質問者

お礼

ご返事ありがとうございます。 人間の目から見ると、普通に日付と認識していましたがEXCELから見ると… おはずかしい限りで、ご教授ありがとうございました。

関連するQ&A

  • VBA 選択したセルが空白であったらシートを削除

    こんばんは!いつもお世話になっています。 選択したシート1のセル(C9)が空白であったら、選択したシートを削除するマクロ(VBA)を作りましたが、上手く作動しなくて困っています。 どうしたらよいのかよろしくお願い致します。 'シート1のセルC9を選択し、空白か判断する Sub セルの選択()   Worksheets("Sheet1").Activate   Range("C9").Select  If Len(Application.Trim(ActiveCell)) = 0 Then   MsgBox("空白セル")  End If End Sub '現在アクティブなシートを削除する Sub DeleteWorksheet() Application.DisplayAlerts = False ActiveSheet.Delete Application.DisplayAlerts = True End Sub

  • セルの値をワークシート名にする(エクセル2013)

    インストラクターのネタ帳さんより http://www.relief.jp/itnote/archives/003382.php 下記「セルの値をワークシート名にする?Worksheet_Change」 を拝借し利用させていただこうと思いましたが ---------------------- Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo ERR_HANDLER If Target.Address(False, False) = "H1" Then ActiveSheet.Name = Range("H1").Value End If Exit Sub ERR_HANDLER: MsgBox "現在のH1セルの値はシート名にできません。" End Sub ---------------------- はそのまま出来るのですが、 H1セルにデータの入力規則:リストを指定しますと エラーとなりシート名が変わりません sheet1のリストA1:A50をsheet2のH1セルにリスト表示させ その表示名をそのままシート名に出来ませんでしょうか? ---------------------- Sub copy Range("H1").Copy Range("P1") End Sub ---------------------- Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo ERR_HANDLER If Target.Address(False, False) = "P1" Then ActiveSheet.Name = Range("P1").Value End If Exit Sub ERR_HANDLER: MsgBox "現在のP41セルの値はシート名にできません。" End Sub ---------------------- としてH1のセルをP1にコピーしたものを指定して試しましたがやはりエラーとなり うまくいきませんでした。 全くの素人で恐縮ですがよろしくお願いいたします

  • VBAでEXCELのワークシートを削除時に警告メッセージをでないようにしたい。

    ACCESSのVBAでEXCELのワークシートを削除時に警告メッセージをでないようにしたいのですが、 ネットを参考に下記のようにしたのですが、  Application.DisplayAlerts = False  ActiveSheet.Delete  Application.DisplayAlerts = True DisplayAlertsが反転してメソッドまたはデータメンバが見つかりません。とエラーメッセージがでます。 ご存知の方宜しくお願いします。

  • ワークシートの削除

    For SheetSakujo = 3 To SheetCount - 1 Worksheets(SheetSakujo).Select If ActiveSheet.Name <> "★" Then If Range("A2") = "" Then ActiveWindow.SelectedSheets.Delete End If ElseIf ActiveSheet.Name = "★" Then Exit For End If Next VBAでワークシートの削除を行っています。 A2が空白のシートを消そうと思って上記のようなコードをくみましたが、 削除されるとシートが減ってしまうため、次のシートも空白だった場合、消されないで飛ばされてしまいます。 3枚目のシート:空白 4枚目のシート:空白 5枚目のシート:空白     ↓ sheetsakujoが「3」なので3枚目は削除される。 次の4枚目のシートが3枚目が削除されたため、「3番目のシート」になるため、次に削除されるのは5枚目のシート。 この場合、どのようにしたらいいのでしょうか?

  • VBA シートの名前が重複するときに すでにある方を削除する

    VBA シートの名前が重複するときに すでにある方を削除する よろしくお願いします。 エクセル2003を使っています。 「入力シート 」をコピーして「DB」という名前をつける。 すでに「DB]シートがあれば「DB」シートを削除する。 その時に、もし「集計」シートと「名簿」シートがあれば一緒に削除する というコードを考えています。 集計シートや名簿シートはない場合もありますので、最初からdeleteにするとエラーになります。 どうぞお知恵をお貸しください。 sub シートの挿入と削除 () Worksheets("入力シート").Activate ActiveSheet.Copy After:=ActiveSheet On Error Resume Next 'エラーが発生しても続行 ActiveSheet.Name = "DB" If Err.Number = 1004 Then Application.DisplayAlerts = False '警告メッセージを表示しない Sheets("DB").Delete Application.DisplayAlerts = True ActiveSheet.Name = "DB" End Sub End If

  • エクセルVBAでワークシート削除

    ブックの中にある、表示されているシートで、たとえば図表1~図表4(何番まであるかは不定です)という名前のシートを削除するVBAを作りました。ただの「図表」という名前のシートや、「何々図表」、「図表集計」等のシートは削除しません。 Sub 保存図表削除() Dim SN As String For Each sh In Worksheets SN = sh.Name If sh.Visible And IsNumeric(Mid(SN, 3, Len(SN) - 2)) And Left(SN, 2) = "図表" Then ans = MsgBox(SN & "を削除してよい?", vbYesNo) If ans = vbYes Then Application.DisplayAlerts = False sh.Delete Application.DisplayAlerts = True End If End If Next End Sub これでうまく作動するのですが、いちいちシートごとに削除の有無を聞かずに、削除するシート名をまとめて表示し、それらを削除するかしないかを聞くにはどうすればよいでしょうか? 「図表1,2,3,4があります。これらを削除しますか?」というような感じです。

  • エクセルで型番ごとにワークシートをマクロで作る方法

    昨日に質問させて頂いたものですが、下記のマクロを教えて頂いたのですが 新しく生成された型番のワークシートが抜けていたり、最後まで型番が生成されない状態です。 なにか間違っていたら直して頂ける方お願いします。 Sub macro4()  Dim h As Range  Dim w As Worksheet  Dim i As Long, e As Long  Application.ScreenUpdating = False  Application.CutCopyMode = False ’準備  Set w = ActiveSheet  w.Range("4:4").Insert shift:=xlShiftDown  e = Range("B65536").End(xlUp).Offset(1).Row  Range("B4").Select ’複写  Do   ActiveSheet.Copy after:=ActiveSheet   Selection.EntireRow.Delete shift:=xlShiftUp  Loop Until ActiveCell.Offset(1) = "" ’片付け  For i = ActiveSheet.Index To w.Index + 1 Step -1  With Worksheets(i)  .Range(.Range("B4").Offset(1), .Cells(e, "B")).EntireRow.Delete shift:=xlShiftUp  End With  Next i  w.Rows(4).Delete  Application.ScreenUpdating = True End Sub http://okwave.jp/qa/q7081084.html

  • exel vba ワークシートデータを日付にしたい

    ワークシートからFIND関数でID検索し、生年月日の検索値をテキストボックスに表示します。 過去データがない場合は日付形式で入力を促すため、日付形式でない場合誕生日EXITでエラーメッセージを表示させます。 過去データがあった場合はワークシートからデータを表示するのですが、ワークシートの日付データが25897のような数値で表示されるのでエラーになります。 ワークシート自体には日付形式で入力されていても、フォームにVBAで値を引っ張ると数値になってしまいます。数値を日付データに戻して表示はどうすればよいでしょうか? ’IDを入力した後のBVAです。 ************************************************************************************************* Private Sub TextBoxID_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim FRange As Range If TextBoxID.Text = "" Then Exit Sub End If ID = TextBoxID.Text On Error GoTo ErrHdl Worksheets("data").Activate With ActiveSheet Set FRange = .Range("b2:b65536").Find(ID, LookIn:=xlValues, LookAt:=xlWhole) If FRange Is Nothing Then MsgBox "新規です" Exit Sub End If TextBoxシメイ.Value = FRange.Offset(0, 1).Value TextBox誕生日.Value = FRange.Offset(0, 2).Value sex = FRange.Offset(0, 3).Value If sex = "M" Then OptionButton男.Value = True Else OptionButton女.Value = True End If TextBox体重.SetFocus End With Exit Sub ErrHdl: MsgBox "エラー" & Err.Number & Chr(13) & Err.Description End Sub *********************************************************************************************** Private Sub TextBox誕生日_Exit(ByVal Cancel As MSForms.ReturnBoolean) If IsDate(TextBox誕生日.Text) = False Then MsgBox "日付型データで入力.ex:H10/5/5" TextBox誕生日.Value = "" Else Exit Sub End If End Sub

  • ワークシートをコピーしたい

    下記載のサンプルマクロは「ワークシートをコピーして、追加したワークブックにコピペする」マクロなんですが、これを「ワークシートをコピーして、追加したワークシートにコピペする」にできないでしょうか? 出来るのであれば、値と書式の他に関数もそのまま貼り付けたいので御教授お願いします。 ただマクロは削除してマクロ抜きのコピペが理想です。 宜しくお願い致します。 Sub サンプル() Dim sc As Integer sc = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 ThisWorkbook.Sheets("オリジナル").Cells.Copy 'コピー Workbooks.Add 'ブック追加 Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlValues '値貼り付け Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlFormats '書式貼り付け Sheets("Sheet1").Name = "コピー" Application.CutCopyMode = False Application.SheetsInNewWorkbook = sc ActiveWorkbook.Close ThisWorkbook.Activate End Sub

  • 【Excel VBA】ワークシートの表示(続き)

    すみません。 追記が出来なかったため、コードの続きをこちらに記載します。 For i = 1 To 12 If actsht = tmp(i) Then Flag = 1 Anser = MsgBox("翌月分シートを作成しますか?", vbYesNo + vbDefaultButton1, "確認") If Anser = vbYes Then ActiveSheet.Copy After:=ActiveSheet ActiveSheet.Name = tmp(i + 1) Sheets(actsht).Tab.ColorIndex = 2 Sheets(actsht).Range("B3").Value = Sheets("Sheet2").Range("A1").Value Sheets(actsht).Range("B4").Value = Sheets("Sheet2").Range("A2").Value ActiveSheet.Range("A2").Select Exit For ElseIf Anser = vbNo Then Exit For End If End If Next If Flag = O Then MsgBox ("新しいワークシートを作成出来ません。") End If If actsht = tmp(i) Then If Sheets(元データ).Visible = False Then Sheets(元データ).Visible = True End If End If End Sub

専門家に質問してみよう