- ベストアンサー
【excel vba】 時刻データのチェック
dim myDate as Variant myDate = activesheet("xxx.xls").range("A1") if <<<myDateが、"hh:mm::ss"形式のデータかどうか？ >>> then 処理１ end if と、したいのですが、 <<<・・・・・>>> の記述内容がわかりません。 ご教授お願い致します。
- riseshinejp
- お礼率33% (60/180)
- オフィス系ソフト
- 回答数4
- ありがとう数4
- みんなの回答 （4）
- 専門家の回答
質問者が選んだベストアンサー
そのままで出来るわけがないと思いますね。 Dim myDate As Variant Set myDate = ActiveSheet.Range("A1") If myDate.NumberFormatLocal Like "hh:mm:ss*" Then ' 処理１ Else MsgBox myDate.NumberFormatLocal & vbCrLf & "違います。", 48 End If
その他の回答 (3)
- ki-aaa
- ベストアンサー率49% (105/213)
こんにちわ Sub test111() Dim myDate As Variant myDate = ActiveSheet.Range("A1").Text If myDate Like "##:##:##" Then MsgBox "hh:mm:ss" Else MsgBox "no" End If End Sub ただこれにも少し問題がありまして、テストされる列の幅を変更して、 時間の表示が"hh:mm:ss" から "####"に成るまで狭くすると、??です。
お礼
参考になりました。 ありがとうございました。
- 米沢 栄蔵（@YON56）
- ベストアンサー率36% (37/102)
myDate..NumberFormatLocal = "hh:mm:ss" で、いけると思います。
お礼
参考になりました。 ありがとうございました。
- tom04
- ベストアンサー率49% (2537/5117)
こんにちは！ こんな感じですかね？ If myDate.NumberFormatLocal = "hh:mm:ss" Then 処理1 End If 参考になれば良いのですが・・・m(__)m
お礼
参考になりました。 ありがとうございました。
関連するQ&A
- Excel VBA 入力規則
入力規則を利用して、３つのセルを連携させることを考えていますが、 不適合な値を張り付けらられた場合に拒否をする方法があるのでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ad As String Dim ma As Range Dim ma2 As Range Dim r As Range Dim r2 As Range Dim r3 As Range Dim r1 As Range Dim m As Long Dim m2 As Long Application.EnableEvents = False If Target = "" Then Range("F7").Validation.Delete Range("F7") = "" If Target.Address(0, 0) = "B7" Then Range("D7").Validation.Delete Range("D7") = "" End If GoTo EXIT_SUB End If With Worksheets("Sheet1") ad = "A4" Set r = .Range(ad) Set ma = r.MergeArea Set r1 = r.Offset(0, 1) m = Application.Match(Range("B7"), .Range(r1, .Cells(r.Row + ma.Count - 1, r1.Column)), 0) Set r2 = .Cells(r.Row + m - 1, r1.Column) Set ma2 = r2.MergeArea If Target.Address(0, 0) = "B7" Then If ma.MergeCells Then setValiS Target.Offset(0, 2), r2 Range("F7").Validation.Delete Target.Offset(0, 2) = "" Target.Offset(0, 4) = "" Else MsgBox "A列が連結されていません。" End If ElseIf Target.Address(0, 0) = "D7" Then Set r3 = r2.Offset(0, 1) m2 = Application.Match(Target, .Range(r3, .Cells(r2.Row + ma2.Count - 1, r3.Column)), 0) setValiS Target.Offset(0, 2), .Cells(r2.Row + m2 - 1, r3.Column) Target.Offset(0, 2) = "" End If End With EXIT_SUB: Application.EnableEvents = True End Sub Sub setVali2() Dim tc As Range Dim c As Range Set tc = Worksheets("登録").Range("D3") Set c = Worksheets("Sheet1").Range("C3") setValiS tc, c End Sub Sub setValiS(tc As Range, c As Range) Dim ss As String Debug.Print tc.Address, c.Address ss = getChildren(c) If ss > "" Then With tc.Validation .Delete .Add Type:=xlValidateList, Formula1:=getChildren(c) End With End If Worksheets("登録").Activate End Sub Function getChildren(c As Range) Dim c1 As Range Dim ss As String Dim s1 As String Worksheets("Sheet1").Activate ss = "" For Each c1 In c.MergeArea s1 = c1.Offset(0, 1) If s1 <> "" Then ss = ss & "," & s1 Next c1 If ss <> "" Then ss = Mid(ss, 2) Else MsgBox "データがありません！" End If getChildren = ss End Function Sub Outline() Dim CheckRow As Long Dim Moji As String Dim TopRow As Long Dim EndRow As Long With ActiveSheet .Range("A2").ClearOutline .Outline.SummaryRow = xlAbove CheckRow0 = .Range("A" & .Rows.Count).End(xlUp).Row CheckRow = CheckRow0 Do If Moji = "" Then Moji = .Cells(CheckRow, 1).Value EndRow = CheckRow ElseIf yy_mm(CDate(.Cells(CheckRow, 1).Value)) = yy_mm(CDate(Moji)) Then TopRow = CheckRow If TopRow = 1 Then .Rows(TopRow + 1 & ":" & EndRow).Rows.Group Exit Do End If Else .Rows(TopRow + 1 & ":" & EndRow).Rows.Group CheckRow = CheckRow + 1 Moji = "" End If CheckRow = CheckRow - 1 Loop Until CheckRow = 1 .Rows(CheckRow + 1 & ":" & EndRow).Rows.Group .Outline.ShowLevels RowLevels:=1 ExecuteExcel4Macro "SHOW.DETAIL(1," & CheckRow0 & ",TRUE)" End With End Sub Function yy_mm(d As Date) yy_mm = Format(d, "yy/mm") End Function
- 締切済み
- その他（プログラミング・開発）
- 【Excel VBA】データの最大値抽出
<まず初めに> QNo.9045833 QNo.9045805 QNo.9045800 QNo.9045456 以前の質問ですが、解決しております。 この場で失礼します。 <本第> Sub 課題() Dim i As Integer Dim max(1 To 4) As Integer Dim row As Integer Dim column(1 To 31) As Variant Dim Index As Integer Dim c As Integer For row = 20 To 23 For Index = 2 To 32 For i = 1 To 4 column(Index) = change_number(Index) MsgBox "変換後の文字列は" & column(Index) & "です。" If Range(column(Index) & row) > max Then max(i) = Range(column(Index) & row) End If Next Next Next End Sub Function change_number(Index As Variant) As Variant Dim al As String If IsNumeric(Index) = True Then al = Cells(1, Index).Address(RowAbsolute:=False, ColumnAbsolute:=False) ★ change_number = Left(al, Len(al) - 1) ★ Else change_number = Range(Val & "1").column ★ End If End Function 処理1～処理4に羅列されているデータの中から、 各最大値を抽出するマクロを作成したいと考えています。 インターネット上の例を参考しつつ、コードを書きました。 実行したところ、「型が一致しません」のエラーメッセージが表示されました。 どこが誤っているか、ご教示いただけないでしょうか。 また、例から引っ張ってきましたコードですが、 ※★印つけています。 何を行っているのかいまいち落とし込めていません。 こちらも併せてご教示いただけないでしょうか。 Excelデータの詳細↓ A20：処理1 A21：処理2 A22：処理3 A23：処理4 B20～AF23：任意の数字
- ベストアンサー
- Excel（エクセル）
- エクセルＶＢＡ 参照するシートを 変数化
早速ですが 参照するシートを 変数化して、冒頭で 宣言したいのですが datasheet1="2012" If Format(datasheet1.Cells(cnt, 2), "hh:mm:ss") = Format("9:00:00", "hh:mm:ss") Then この様な扱い方なんですが Dim datasheet1 As Object とやってもダメでした。 よろしくどうぞ
- ベストアンサー
- Visual Basic
- EXCEL2000とEXCEL2003のVBAについて
現在、EXCEL2000で下記のコードを実行しています。 が、EXCEL2003で実行すると、 .UsedRange.Copy myb のコードが実行されているのにコピー出来ていません。 ファイルは開いていて、エラーは出ていないのです。 問題点わかる方教えていただけますか？ Sub 日別データ読込() Dim rngsaki As Range Dim pathmacrobook As String Dim namebook As String Dim motobook As Workbook Dim myb As Variant Set rngsaki = Workbooks("残高集計用.xls").Worksheets(3).Range("a2") pathmacrobook = ThisWorkbook.Path & "\CSV読込データ12\" namebook = Dir(pathmacrobook & "*.xls") Do While Not namebook = "" Set motobook = Workbooks.Open(pathmacrobook & namebook) Set myb = Workbooks("残高集計用.xls").Worksheets(3).Range("A65536").End(xlUp) With motobook.Worksheets("Sheet1") .UsedRange.Copy myb End With motobook.Close False namebook = Dir() Loop MsgBox "完了しました" End Sub
- ベストアンサー
- オフィス系ソフト
- VBAにて
質問です。 入力したデータから入力範囲まで ある条件を超えたら（例えば 100超えたら セル色を黄色にする） セル色を変えるＶＢＡを作りたいのですが 何故か？出来ません。 知識ある方々・ご意見ある方々のご意見やアドバイスを お願いします。 コードは下記に記入しました。 Private Sub 色付け_Click() Dim n1 As Variant Dim n2 As Variant Dim i As Variant n1 = Range("C3") n2 = Range("C3").End(xlDown) For i = n1 To n2 If i.Value >= 32000 Then i.Interior.ColorIndex = 38 End If Next i End Sub
- ベストアンサー
- Excel（エクセル）
- VBAのcountif
ここで質問させていただき、配列に必要なデータを入力する所までは出来ました。 次に各行ごとの"OK"の数をカウントしたいのですが、どのように記述すればよいのでしょうか？ Sub count0(a, b, c, d, e) Dim i1 As Long Dim i2 As Long Dim A1 As String Dim bb As Variant Dim cc As Variant Dim dd As Variant Dim ee As Variant Dim myLastRow As Long Sheets(a).Select myLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 bb = Range(b).Resize(myLastRow, 6) cc = Range(c).Resize(myLastRow, 6) dd = Range(d).Resize(myLastRow, 6) ee = Range(e).Resize(myLastRow) For i1 = 1 To myLastRow For i2 = 1 To 6 If bb(i1, i2) = "" Then A1 = "NG" ElseIf bb(i1, i2) = "A1" Or cc(i1, i2) = "A1" Then A1 = "-" ElseIf bb(i1, i2) = cc(i1, i2) Then A1 = "OK" Else A1 = "NG" End If dd(i1, i2) = A1 Next i2 '配列をカウントするこの行以降の記述が良く分かりません。 ee(i1) = Application.WorksheetFunction.CountIf(dd(), "OK") Next i1 Range(e).Resize(myLastRow) = ee End Sub
- ベストアンサー
- その他MS Office製品
- エクセルでデータ入力された日付と時間を自動入力する
A1をA2に、B1をB2に、C1をC2に･･･ A1に入力したらA2に更新日付が入るという様に行いたいのですが、 ---------------- Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim r As Range For Each r In Target If r.Column = 1 Then r.Offset(0, 1).Value = Format(Now, “yyyy/mm/dd”“ ”“hh:mm:ss”) End If Next r End Sub ---------------- これをどのように改編したらいいのでしょうか？
- ベストアンサー
- Excel（エクセル）
- Excel2010 VBA 条件色付け
Sub sample() Dim r As Range For Each r In Range("q6:q30") If myIsNumeric(r) Then r.Offset(0, 1).Value = "数字" Else r.Offset(0, 1).Value = "文字" End If Next End Sub Function myIsNumeric(Target As Range) Dim r As Range Dim buf, tmp Dim flg As Boolean Dim i As Integer buf = Target For i = 1 To Len(buf) tmp = Mid(buf, i, 1) If IsNumeric(tmp) Then flg = True Exit For End If Next myIsNumeric = flg End Function を数字が入ってたら塗りつぶさないで、 数字が入ってなかったら塗りつぶすように直したいです。 あああ→塗る あああ1－1→塗らない 住所→塗る 住所12→塗らない
- ベストアンサー
- Excel（エクセル）
- vba 初心者
Dim a As Integer Dim inbox As String Dim Localpath As Variant Dim c As Range, myFadd As String Dim flag As Variant Dim MyShell As Object Dim Mysh As String Dim newHour As Variant Dim newMinute As Variant Dim newSecond As Variant Dim waitTime As Variant Localpath = ThisWorkbook.Path a = 1 inbox = InputBox("番号") Do If inbox = Empty Then Exit Sub End If If inbox = Cells(a, 1) Then MsgBox ("あります") Exit Do Else a = a + 1 ElseIf Cells(a, 1) <> inbox Then MsgBox ("ない") End If Loop Set MyShell = CreateObject("WScript.Shell") MyShell.Run ("AcroRd32.exe /n") MyShell.Run ("AcroRd32.exe /p") & Localpath & "\" & Myfile & ".pdf" newHour = Hour(Now()) newMinute = Minute(Now()) newSecond = Second(Now()) + 10 waitTime = TimeSerial(newHour, newMinute, newSecond) Application.Wait waitTime Application.SendKeys "{Enter}", True '次の使用例は、10 秒を過ぎるとメッセージを表示します。 If Application.Wait(Now + TimeValue("0:00:10")) Then MsgBox "時間が過ぎました。" End If End Sub ExcelからPDFファイルを検索して印刷したいのですが、 見よう見まねで作ってみたもののエラーが出てしまってよく分かりません。 指摘できるところご指導よろしくお願いします。
- 締切済み
- Visual Basic
- 『続き』 質問番号：701776EXCEL_VBA
■質問番号701776の続きです。よろしくお願いいたします。 http://okwave.jp/qa/q7017764.html ■依頼内容 下記コードで アプリケーション定義またはオブジェクト定義のエラー(実行時エラー1004)を修正したい。 エクセルの関数で =IF(ISERROR(A1/B1),"",A1/B1) といった関数を作成すると、エラー値は非表示で、エラーでない場合のみ、計算しますが、 VBAで同様の式を利用しようとすると、エラーとなって実行できません。ご教授お願いいたします。 Sub macro1() Dim w As Workbook Dim mydate As Date, mydays As Long Set w = Workbooks.Open(Filename:=ThisWorkbook.Path & "\実験データ.xls") mydate = ThisWorkbook.Worksheets(1).Range("E1") mydate = mydate - Day(mydate) + 1 '念のため。 mydays = Day(DateAdd("M", 1, mydate) - 1) ThisWorkbook.Worksheets(1).Range("C5:I35").ClearContents With ThisWorkbook.Worksheets(1).Range("C5").Resize(mydays, 7) .Formula = "=IF(ISERROR(VLOOKUP($E$1-DAY($E$1)+$B5,[実験データ.xls]data!$B:$K,MATCH(C$4,[実験データ.xls]data!$B$1:$K$1,0))),"",VLOOKUP($E$1-DAY($E$1)+$B5,[実験データ.xls]data!$B:$K,MATCH(C$4,[実験データ.xls]data!$B$1:$K$1,0)))" .Value = .Value End With w.Close savechanges:=False End Sub
- ベストアンサー
- オフィス系ソフト
お礼
参考になりました。 ありがとうございました。