exel vbaのワークシートデータを日付に変換する方法

前へ 次へ
このQ&Aのポイント
  • ワークシートからＩＤを検索し、生年月日の値をテキストボックスに表示する方法について解説します。
  • 日付形式で入力されたワークシートデータをVBAで値を引っ張ると数値になってしまう問題についても触れます。
  • 日付形式でない場合はエラーメッセージを表示させ、日付型データで入力するように促します。
回答を見る
  • ベストアンサー

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

ワークシートからＦＩＮＤ関数でＩＤ検索し、生年月日の検索値をテキストボックスに表示します。 過去データがない場合は日付形式で入力を促すため、日付形式でない場合誕生日EXITでエラーメッセージを表示させます。 過去データがあった場合はワークシートからデータを表示するのですが、ワークシートの日付データが25897のような数値で表示されるのでエラーになります。 ワークシート自体には日付形式で入力されていても、フォームにＶＢＡで値を引っ張ると数値になってしまいます。数値を日付データに戻して表示はどうすればよいでしょうか？ ’ＩＤを入力した後のＢＶＡです。 ************************************************************************************************* 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:ｂ65536").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

画像を拡大する

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

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1606/2443)
回答No.2

> 和暦表示は無理でしょうか? CDate外してFormatでいけると思います。 TextBox誕生日.Value = Format(FRange.Offset(0, 2).Value, "ggge年m月d日") いけなかった場合CDateをのこしてFormatしてください。 TextBox誕生日.Value = Format(CDate(FRange.Offset(0, 2).Value), "ggge年m月d日")

makisaori
質問者

お礼

ほぼ完成しました!! いろいろありがとうございました。 いろいろできてくると他のエラー処理とかも（例えばＩＤの桁数制限）やりたくなってきました。 自分で調べてわからなかったらまた投稿しますのでよろしくお願いします。

makisaori
質問者

補足

ありがとうございます。s50/5/5の形式にしたかったので "ge/m/d"としました。

その他の回答 (1)

  • kkkkkm
  • ベストアンサー率65% (1606/2443)
回答No.1

> ワークシートの日付データが25897のような数値で表示されるのでエラーになります TextBox誕生日に値を入れるときにCDateでセルの値を日付型に変換します。 日付型にできる値か数値でなければエラーになるので、日付か数値の場合に値を入れます。 If IsDate(FRange.Offset(0, 2).Value) Or IsNumeric(FRange.Offset(0, 2).Value) Then TextBox誕生日.Value = CDate(FRange.Offset(0, 2).Value) End If

makisaori
質問者

補足

早速ありがとうございます。和暦表示は無理でしょうか?

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

関連するQ&A

  • エクセル VBAのチェックボックスについて

    お読みくださり、ありがとうございます。 エクセル初心者でございます。 エクセルのマクロなのですが、 お詳しい方、是非教えて欲しいです！汗 調子に乗って入力フォームなるものを作りました。 入力フォームの中にて、チェックボックスで「ある」「なし」の項目を入れてみたのですが、チェックしていないのに、値が入る現象が起きています汗 以下、素人が書いたコードを恥を承知で記載させていただきます。 Private Sub CheckBox1_Click() If CheckBox1.Value = True Then OK = "○" End If End Sub Private Sub CheckBox2_Click() If CheckBox2.Value = True Then NO = "×" End If End Sub Private Sub UserForm_Click() End Sub '以下のコードは、登録ボタンがクリックされたときの処理！ Private Sub 登録ボタン_Click() If TextBox1.Text = "" Then MsgBox "グッズ名を入力してください。" Exit Sub End If If TextBox2.Text = "" Then MsgBox "アプローチ先を入力してください。" Exit Sub End If With Worksheets("協賛グッズ") With Cells(Rows.Count, 2).End(xlUp) .Offset(1, 0).Value = TextBox1.Text .Offset(1, 1).Value = mori .Offset(1, 2).Value = mori2 .Offset(1, 3).Value = TextBox2.Text .Offset(1, 5).Value = TextBox3.Text .Offset(1, 6).Value = TextBox4.Text .Offset(1, 7).Value = TextBox5.Text .Offset(1, 8).Value = TextBox6.Text End With End With TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" TextBox5.Text = "" TextBox6.Text = "" CheckBox1.Value = False CheckBox2.Value = False End Sub 以上です。 おかしなところ満載かと思いますが、 チェックを入れた項目だけ値を入れたいと考えております。 おわかりになるかたおりましたら何卒お助けください汗 よろしくお願いいたします。

  • マクロにおける条件文の作成の件

    以下の様に条件付きの計算式を作成しました。CommandButton3を押しても 計算しなかったり、TextBox3.Value > TextBox1　ではないときでもエラー メッセージが出ます。どこに欠点があるのか教えて下さい。 Private Sub CommandButton3_Click() Dim row As Integer If TextBox1.Value = Empty Then MsgBox ("Ａが空欄です") Exit Sub End If If TextBox2.Value = Empty Then MsgBox ("Ｂが空欄です") Exit Sub End If If TextBox3.Value = Empty Then MsgBox ("Ｃが空欄です") Exit Sub End If If TextBox4.Value = Empty Then MsgBox ("Ｄが空欄です") Exit Sub End If If TextBox3.Value > TextBox1.Value Then MsgBox ("Ｃの値をＡの値より小さくしましょう！") Exit Sub End If If TextBox4.Value > TextBox2.Value Then MsgBox ("Ｄの値をＢの値より小さくしましょう！") Exit Sub End If TextBox5 = Round(TextBox1 * TextBox2 - (TextBox1 - TextBox3) * (TextBox2 - TextBox4) / 2, 0) End Sub

  • excel match で日付が見つからない

    ■困っていること vbaの worksheetfunction のmatach関数を用いているが、日付が見つかってくれない。 なぜ見つからないか、原因を教えていただけないでしょうか?よろしくお願いします。 ■状況、やりたいこと 下記、コードで、「ｆRow」と「syu」までは正しく求められるのですが、「tcol」を求めようとすると、どうしても０になってしまいます。 ワークシートはD1セルに日付を入力おり、さらに右のセルへ行く毎に+7しています。「syu」の日付がどの週に該当するのかを、列数で求めたいです。 例えば、10年3月17日なら、Fの列なので 6 を求められるようにしたいです。 sub test() Dim fRow As Long Dim tcol As Long Dim syu As long With Worksheets("data") Set fRange = Sheets("data").Columns(1).Find(What:=TextBox1.Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then Exit Sub End If fRow = fRange.Row 　　syu = .Cells(fRow, 2).Value tcol = Application.WorksheetFunction.Match(syu, .Range("1:1"), 1) msgbox tcol 　　end with end sub

  • 処理速度を速くする方法教えてください。

    Private Sub CommandButton1_Click() Dim irow As Long Dim Celldata(1 To 6) As Double Dim ekimen(1 To 6) As String '高さ読込み If TextBox8.Value = "" Then MsgBox ("No.を入力") End End If If TextBox9.Value = "" Then MsgBox ("温度を入力") End End If If TextBox10.Value = "" Then MsgBox ("係数を入力") End End If Celldata(1) = TextBox1.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value Celldata(2) = TextBox2.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value Celldata(3) = TextBox3.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value Celldata(4) = TextBox4.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value Celldata(5) = TextBox5.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value Celldata(6) = TextBox6.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value '入力と修正 Dim i As Long '最終行から試験Noが一致するものを探す For i = 65535 To 6 Step -1 If CStr(Cells(i, 1)) = Trim(TextBox8.Value) Then Set myrange = Sheets("データ").Cells(i - 1, 1) '記入セルがoffset(1,x)になっているため、i-1にしています。 Exit For End If Next i 'Noが一致しない場合、最終行を記入セルに設定する。 If i = 5 Then Set myrange = Sheets("データ").Range("A65536").End(xlUp) End If 'ワークシートへの転記 With myrange .Offset(1, 0).Value = TextBox8.Value '----No. .Offset(1, 1).Value = Celldata(1) '----１計測 .Offset(1, 2).Value = Celldata(2) '----２計測 .Offset(1, 3).Value = Celldata(3) '----３ル計測 .Offset(1, 4).Value = Celldata(4) '----４計測 .Offset(1, 5).Value = Celldata(5) '----５計測 .Offset(1, 6).Value = Celldata(6) '----６計測 .Offset(1, 13).Value = TextBox1.Value '----１追加 .Offset(1, 14).Value = TextBox2.Value '----２追加 .Offset(1, 15).Value = TextBox3.Value '----３追加 .Offset(1, 16).Value = TextBox4.Value '----４追加 .Offset(1, 17).Value = TextBox5.Value '----５追加 .Offset(1, 18).Value = TextBox6.Value '----６追加 .Offset(1, 19).Value = TextBox7.Value '---温度 .Offset(1, 20).Value = TextBox11.Value '----１高さ .Offset(1, 21).Value = TextBox12.Value '----２高さ .Offset(1, 22).Value = TextBox13.Value '----３高さ .Offset(1, 23).Value = TextBox14.Value '----４高さ .Offset(1, 24).Value = TextBox15.Value '----５高さ .Offset(1, 25).Value = TextBox16.Value '----６高さ '入力ボックスのクリア TextBox1.Value = "" '----1セル TextBox2.Value = "" '----2セル TextBox3.Value = "" '----3セル TextBox4.Value = "" '----4セル TextBox5.Value = "" '----5セル TextBox6.Value = "" '----6セル TextBox7.Value = "" '---温度 TextBox11.Value = "" '----1セル TextBox12.Value = "" '----2セル TextBox13.Value = "" '----3セル TextBox14.Value = "" '----4セル TextBox15.Value = "" '----5セル TextBox16.Value = "" '----6セル End With 'lblComment.Caption = "ワークシートに転記しました！" End Sub Private Sub CommandButton2_Click() Dim i As Long '入力チェック If TextBox8.Value = "" Then MsgBox ("No.を入力") End End If If TextBox9.Value = "" Then MsgBox ("温度を入力") End End If If TextBox10.Value = "" Then MsgBox ("係数を入力") End End If For i = 65535 To 6 Step -1 If CStr(Cells(i, 1)) = Trim(TextBox8.Value) Then Set myrange = Sheets("データ").Cells(i - 1, 1) '記入セルがoffset(1,x)になっているため、i-1にしています。 Exit For End If Next i '受付No.がない場合、終了します。 If i = 5 Then MsgBox ("No.が見つかりません") End End If '入力の処理と逆の処理を行います。 With myrange TextBox1.Value = .Offset(1, 13).Value '---１計測 TextBox2.Value = .Offset(1, 14).Value '---２計測 TextBox3.Value = .Offset(1, 15).Value '---３計測 TextBox4.Value = .Offset(1, 16).Value '---４計測 TextBox5.Value = .Offset(1, 17).Value '---５計測 TextBox6.Value = .Offset(1, 18).Value '---６計測 TextBox7.Value = .Offset(1, 19).Value '---温度 TextBox11.Value = .Offset(1, 20).Value '---１高さ TextBox12.Value = .Offset(1, 21).Value '---２高さ TextBox13.Value = .Offset(1, 22).Value '---３高さ TextBox14.Value = .Offset(1, 23).Value '---４高さ TextBox15.Value = .Offset(1, 24).Value '---５高さ TextBox16.Value = .Offset(1, 25).Value '---６高さ End With End Sub

  • 入力時エラーメッセージの出し方

    http://oshiete1.goo.ne.jp/qa3745129.htmlを参考に 下記の構文を作りましたが、エラーメッセージが出せなく困っています。 フォームで入力を行う際に、該当ボックスで車番一覧にデータの無いものに関してエラーメッセージを出したいと考えています。 修正箇所に関してご指摘いただければと思います。 よろしくお願いします。 Private Sub CommandButton1_Click() Dim check As Long '重複の有無(=0:重複せず,>0:重複) With Cells(Rows.Count, 1).End(xlUp).Offset(1) .Value = TextBox1.Text .Offset(0, 1).Value = TextBox2.Text .Offset(0, 2).Value = TextBox3.Text .Offset(0, 4).Value = TextBox4.Text On Error Resume Next check = 0 check = WorksheetFunction.Match(CInt(TextBox2.Text), Range("車番一覧", Columns(1))) On Error GoTo 0 If check = 0 Then MsgBox "その車番は登録されていません！", vbExclamation, "入力エラー" TextBox2.SetFocus Exit Sub End If Exit Sub End With TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" If TextBox1.Text = "" Then TextBox1.SetFocus End If Range("A1").Sort Key1:=Range("A1"), order1:=xlAscending, Key2:=Range("A1"), order2:=xlAscending, Header:=xlGuess End Sub

  • EXCEL VBA---IsDate

    お知恵をお貸し下さい。 VBAでフォームを作成し、テキストボックスに数字（日付）を入力 （入力→10/7， 表示→2005/10/07） それを、IsDateで日付かどうかチェックさせたいのですが 下記のコードでは、例えば10月35日と入力してもエラーになりません。 （入力→10/35， 表示→1935/10/01) 2005/10/35と入力すればエラーになってくれるのですが やはりこの方法しかないのでしょうか？ もし、良い方法がありましたらお教え下さい。 よろしくお願いします。 ----------------------------------------------------------------- Sub Test() Dim Data As Variant Data = TextBox16.Text If IsDate(Data) Then TextBox16.Value = CDate(Data) Else MsgBox ("正しい日付を入力してください。") End if End sub -----------------------------------------------------------------

  • EXCEL　VBA　データ抽出について

    ユーザーフォームを利用して、データの管理を行なっております 各データには、コードを設定しており 検出時に利用しています フォームでコードを入力する際には 前半（年・月）　後半（No.）で２か所に分けて入力しており 以下、コード前半⇒　コード１ 　　　　コード後半⇒　コード２　　・・・としておきます シートへの転記も、コード１はA列・コード２はB列に分けて書き込んでいます 以下は、コードからデータを検出し、その内容をテキストボックスへ表記するように 書いたコードですが、コード１のみでの検索になっております コード２をどのように組み込めばいいのか、わからずとても困っています。 シート名　AllDate コード１　TextBox36　　　　（A列） コード２　TextBox37　　　　（B列） １行目は項目名になっており、２行目からデータが蓄積されています。 また新規で登録した場合には、空欄最下部へフォームからシートへ転記されるように設定しています 　 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ Worksheets("AllDate").Activate Dim i As Long, kb As String If TextBox36.Text = "" Then MsgBox "検索する番号を入力してください" Exit Sub End If For i = 2 To Range("A1").CurrentRegion.Rows.Count If Cells(i, 1).Text = TextBox36.Text Then kb = TextBox36.Text Exit For End If Next If kb = "" Then MsgBox "指定した番号はありません" Exit Sub Else Call ReadRecord(kb) End If TextBox36.Text = "" TextBox37.Text = "" End Sub Sub ReadRecord(kb As String) Dim rw As Long Set kRange = Range("A1").CurrentRegion.Columns(1).Find(What:=kb, LookAt:=xlWhole) If kRange Is Nothing Then MsgBox "データがありません" Exit Sub End If rw = kRange.Row TextBox1.Text = Cells(rw, 1).Value TextBox2.Text = Cells(rw, 2).Value TextBox3Text = Cells(rw, 3).Value TextBox4.Text = Cells(rw, 4).Value ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ また自分なりにも何とか模索しており、フィルターを使う方法も考えておりますが 何分まだまだ初心者LVの為、 こちらも難航しております。 フィルタを使用する場合 TextBox36の値で、A列にて抽出 抽出されたデータから、さらに TextBox37の値で、B列にて抽出 重複データは存在しないので、A２行へ常に１件のデータが残り それをセル指定で、テキストボックスへ転記さようと考えています。 また、修正⇒上書き作業も必要なので フィルタで抽出したデータをテキストボックスへ表示させ 修正後、同様にA２行へ書き込み その後、フィルター解除がいいのかな？と思っています。 長々となり恐縮なのですが 方法のオススめ コードのご教授など お力をお貸しいただけないでしょうか？ よろしくお願いいたします！！

  • 【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

  • excel2000 vba スピンボタン

    いつもお世話になっています。 下記内容の変更をしたいのですが、自分ではうまくいかず、お力をお貸しください。 よろしくお願いします。 一枚のデータシートと一枚の入力用フォームがあります。 入力フォームのスピンボタンのＮＯをキーにして、データシートのレコードを一件ずつ切り替えて、表示させるようにしています。 さてデータシートのオートフィルターでフィルターをかけた時に、それにあわせて、スピンボタンのＮＯを飛ばすようにしたいのですが、どのように修正していいか、わかりません。 現状ですと、下記プロシージャですが、いまのままだと、スピンボタンの値が一つずつしかかわりません。 'スピンボタンの値が変わったらテキストボックスに反映 Private Sub SpinButton1_Change() TextBox1.Value = SpinButton1.Value Call hyouji End Sub Private Sub hyouji() 'データを検索して表示する Dim fRange As Range Dim fRow As Long Set fRange = Sheets("data").Columns(3).Find(what:=TextBox1.Value, _ LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then ' MsgBox "Noがみつかりません", vbExclamation Exit Sub End If fRow = fRange.Row '検索されたNoの行位置を求める With Worksheets("data") TextBox2.Value = .Cells(fRow, 4).Value TextBox3.Value = .Cells(fRow, 5).Value TextBox4.Value = .Cells(fRow, 6).Value TextBox5.Value = .Cells(fRow, 7).Value TextBox6.Value = .Cells(fRow, 8).Value End With SpinButton1.SetFocus End Sub ※現物ファイルを下記に投稿（No5643）させていただきました。見ていただけると幸いです。 http://www.kent-web.com/pubc/book/test/uploader/uploader.cgi

  • VBA 空白をエラー表示させる！

    ボタンをクリックすると、入力ミスがないように MsgBoxで表示させるものを作りましたが TextBox3を都合のため切り取りました！ そしたら、エラー表示され If Controls("TextBox" & i).Text = "" Then ↑黄色く表示されます！ どのように下の記述を変えれば良いか教えてください！ Private Sub CommandButton5_Click() Dim i As Integer For i = 1 To 9 If Controls("TextBox" & i).Text = "" Then MsgBox "判定入力していない項目がありますよ！", vbInformation, "空欄を見て！" Exit Sub End If Next If MsgBox("記録するよ？", vbOKCancel) = vbOK Then With Worksheets("グラフ") 'アセスメント身体 .Range("U2").Value = TextBox1.Value .Range("U3").Value = TextBox2.Value .Range("U4").Value = TextBox3.Value .Range("U5").Value = TextBox4.Value .Range("U6").Value = TextBox5.Value .Range("U7").Value = TextBox6.Value .Range("U8").Value = TextBox7.Value .Range("U9").Value = TextBox8.Value .Range("U10").Value = TextBox9.Value

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する