• 締切済み

VBAでタイムシリアル値から日付のみ抜き出す方法について

VBAでアプリケーションを作っています。 要件 1.yyyy/mm/dd/hh:mm形式のA列があり、その列をもとにB列に日の部分だけ表示したい。たとえば、9/22日の場合は22という風に数値型で表示。 2.B列の値を使ってソートするため、タイムシリアル値の表示形式をNumberFormatなどで変換するのではなく、VBAの処理でタイムシリアル値から日を求めたい。 3.A列の行数は毎月異なる。 要件3の部分は、while文でA列が空白になるまでループさせることで解決しました。(数千行あるので、もう少し効率化できたらいいのですが) 今、要件2の部分でつまづいています。 はじめはA列をコピーしてB列にペーストしたのですが、それでは当然実データがタイムシリアル値のためソートするとおかしくなりました。 なのでA列から日のみを抜き出してB列に入れる処理を作成中なのですが、 Dim cnt As Integer Dim day1 As Date Dim day2 As Integer cnt = 3 Do While ActiveCell.Value <> "" Range("A" & cnt).Select day1 = day(Selection.Value) day2 = CInt(day1) Range("B" & cnt).Value = day2 cnt = cnt + 1 Loop これで元データ(8/1 0:00~8/31 23:55まで昇順)で試すと、 8/1は普通に1が入るのですが、8/2以降は1900/1/2といった 形式のデータがB列に入ってしまいます。 初心者で申し訳ないのですが、どうしたらいいのかわからないので教えてください。 また、要件3はループだと8000回以上繰り返すことになるのですが、 もっと効率のいい方法があれば知りたいです。

みんなの回答

  • myRange
  • ベストアンサー率71% (339/472)
回答No.4

回答は出てますが、 折角質問者のコードがあるのでそれでスピードアップを図る方法を。 提示のコードの問題点は、セルをSelectしてる点にあります。 これは一回一回マウスでセルをクリックしているイメージですね。 で、Selectしないようにします。 '---------------------------------------------  Sub Test()  Dim Stime  Stime = Time  Dim Cnt As Long  Dim Day2 As Integer  Range("B:B").NumberFormatLocal = "##"  '●B列表示形式、数値  Cnt = 3  Do While Range("A" & Cnt).Value <> ""    Day2 = Day(Range("A" & Cnt).Value)    Range("B" & Cnt).Value = Day2    Cnt = Cnt + 1  Loop  MsgBox Stime & vbLf & Time End Sub '---------------------------------------------- 上記のようにSelectしなければ数千行でも1~2秒程度でしょう。 それから、今回のように変数でセルを参照する場合は   Range("A" & cnt).Value より   Cells(cnt, 1).Value   Cells(cnt, "A").Value の方がいいのかな、と思います。 ●セルやシートのSelectは必要最小限にすること! 以上です。    

全文を見る
すると、全ての回答が全文表示されます。
  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

>8/2以降は1900/1/2といった 形式のデータがB列に入ってしまいます。 こんなのVBAの質問でなく、エクセルの書式の基礎事項ですよ。 VBAで結果をセルにセットするとき、数値で扱いたい(見たい)ときは、数値の書式にするのは常識。 日付書式を扱っていると、日付データ(当然書式は日付になっている)付近のセルの結果も、自動で書式が日付扱いになってしまう事は良く経験する。その場合 手動で または VBAで 前もって、または気づいて事後に数値書式に設定すれば仕舞い。 また日付というと、年月日か年月日+時刻をいう。質問文では、(年月日の)「日」と表現しないとおかしい部分がある。 第2 >値を使ってソートするため >表示形式をNumberFormatなどで変換するのではなく (A)エクセルでも、(他のアプリでも、基本的には)、ソートはセルの「値」で並べ替えるのだ。書式ではない。書く必要なし。 (B)日付は、エクセルでは、セルの値を、日付シリアル値という正整数で持っている。そのままソートすれば整数のソートになり、自ずと日付順になるので、なんら考える必要なし。 >VBAの処理でタイムシリアル値から日を求めたい。 ごたごた書いているが、VBAには、Day関数があるので、日は Day(Range(”A1”))のように取れる。 ーー VBA云々のまえに、エクセルの、書式、日付シリアル値、セルの値とセルの表示形式、その他(コメントなど)の区別の認識など勉強のこと。エクセルの知識があって、その後エクセルVBAがあることを思い起こすこと。 ーーー >要件3の部分は、while文でA列が空白になるまでループさせることで解決しました これもエクセルの場合は、最終行番号を求めForNextでの繰り返しの方法をお勧めする。

全文を見る
すると、全ての回答が全文表示されます。
  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.2

n-junです。 >8/1は普通に1が入るのですが、8/2以降は1900/1/2といった >形式のデータがB列に入ってしまいます。 事前にB列の「セルの書式設定」が日付になっているため、上記のような 表示になっていると思います。

全文を見る
すると、全ての回答が全文表示されます。
  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

Sub try()  With Range("A3", Cells(Rows.Count, 1).End(xlUp)).Offset(, 1)      .Formula = "=DAY(A3)"      .Value = .Value      .NumberFormatLocal = "G/標準"  End With End Sub みたいな感じでしょうか? ⇒A列はA3以下にデータがあるとしてますので。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • VBA 選択された離れたセルの値の取得について

    EXCELのVBAでどうしても前に進めず困っております。 目的としているコードは、離れたセル(複数)をあらかじめCtrlキーで選択状態にしておき、選択されたセルの値のみをVBAが別のセルに並べていくというものです。 以下が私の作ったコードなのですが、思ったとおりの動作をしてくれません。 VBA初心者なもので、おかしな記述がたくさんあると思うのですが、どなたかアドバイスお願いします。 Public Sub xx() Dim SelectArea As String Dim TargetCell As Range Dim a As Integer Dim Row As Integer Dim Column As Integer Dim CNT1 As Integer a = 0 Row = 0 Column = 0 For CNT1 = 1 To 10 Row = Row + 1 SelectArea = Selection.Address Set TargetCell = Range("B3").Cells(Row - 1, Column) If Intersect(Range(SelectArea), TargetCell) Is Nothing Then Else Range("A30").Cells(a, 0) = Range("B3").Cells(Row - 1, Column).Value a = a + 1 End If Next End Sub

  • VBAの得意な方、教えてください(初心者です)

    エクセルのシートが セルA1に1 セルA2に2 セルA3に3 セルA4に4 セルA5に5 という数字が入っています。 で、セルD4には"=D2*5"という数式が入っています。 セルD2にA1の数値を代入して、出てきた数値をB1に入力、 次にD2にA2の数値を代入して、出てきた数値をB2に入力…以下続く というのをVBAで書いてみたら、下のような感じになりました。 Sub test() Dim d1 As Integer Dim d2 As Integer Dim d3 As Integer Dim d4 As Integer Dim d5 As Integer Dim p1 As Integer Dim p2 As Integer Dim p3 As Integer Dim p4 As Integer Dim p5 As Integer d1 = Cells(1, 1).Value Cells(2, 4).Value = d1 p1 = Cells(4, 4).Value Cells(1, 2).Value = p1 d2 = Cells(2, 1).Value Cells(2, 4).Value = d2 p2 = Cells(4, 4).Value Cells(2, 2).Value = p2 d3 = Cells(3, 1).Value Cells(2, 4).Value = d3 p3 = Cells(4, 4).Value Cells(3, 2).Value = p3 d4 = Cells(4, 1).Value Cells(2, 4).Value = d4 p4 = Cells(4, 4).Value Cells(4, 2).Value = p4 d5 = Cells(5, 1).Value Cells(2, 4).Value = d5 p5 = Cells(4, 4).Value Cells(5, 2).Value = p5 End Sub ここで質問です。 例では5個しかないのですが、実際は100行くらいのデータなんで 大変です。もっと簡単にする方法はありますか? 実際のセルD4の数式は、他からも参照したりしているので、 ここはいじらずに教えてください。 Excel2000、Visual Basic 6.0 ってのを使っています。 よろしくお願いいたします。

  • VBAで実行時エラー'13': がでます

    初歩の初歩ですいません。 VBAで Dim A As Integer Dim B As Integer Dim C As Integer Dim gokei As Integer For i = 8 To 70 A = Cells(i, 4).Value B = Cells(i, 5).Value C = Cells(i, 6).Value goukei = A + B + C Cells(i, 7) = goukei Next i としていますが A = Cells(i, 4).Value のところで今使っているシートだと止まってしまいます。 新規でワークシートを使って仮に数字を代入すると普通に動きます。 今使っているシートもセル内には =100 と入力して 100 と表示され セルの書式設定も数値になってるんですがどうしてでしょうか?

  • VBA勉強中、教えてください。

    下のような表のA、B、Cの期間ごとの合計を出したいのですがうまくいきません。 マスター(sheet1)                    合計(sheet2)     A     B     C    D            A   B    C 1       商品A  商品B  商品C      1   7       合計 2  12/25   18    10    20        2  2/31   3  12/26   18    11    15        3      商品A 4  12/27   20    12    10        4      商品B    5  12/28   24    20    16        5      商品C 6  12/29   30    18    15 7  12/30   18    30    25 8  12/31   23    21    10 ユーザーフォームに日付と何日(数字入力)のフォームが作ってあります Dim i As Integer, x As Integer,dy1 As Variant,gk1 As Variant, tag1 As Variant, cnt As Integer cnt = Worksheets("合計"),Range("A1") dy1 = Application.Match(Worksheets("合計").Range("A2"), Worksheets("マスター").Range("A:A"), 0) For x = 0 To 3 tag1 = Application.Match(Worksheets("合計").Cells(3 + x, 2), Worksheets("マスター").Range("1:1"), 0) For i = 0 To cnt gk1 = gk1 + Worksheets("マスター").Cells(dy1 - i, tag1).Value Next i Worksheets("合計").Cells(2 + x, 3).Value = gk1 Next x    このようなコードにしたのですが合計がA→B→Cとすべて足されてしまいます。A,B,Cとそれぞれの合計を出すにはどのようにしたらよいのでしょうか? 思考錯誤したのですが初心者なのでよくわかりません。 どなたかわかる方が居たら教えてください。よろしくお願いします。

  • VBAで行列を作る方法

    次のようなプログラミングで1,0,-1の要素で作られる3×3行列を全通り調べています。 この場合3の9乗通り調べることができます。 これを4×4や5×5行列など数を大きくして調べたいのですが、このプログラムを配列を使うなどして 簡単にできる方法を教えてください。 よろしくおねがいします。 Sub test() Dim a As Integer '行 Dim b As Integer '列 Dim c As Integer, i As Integer, j As Integer, d As Integer, e As Integer Dim 内積 As Integer, step As Integer Dim f As Integer, g As Integer, h As Integer, l As Integer, m As Integer, n As Integer, k As Integer, x As Integer Dim sum As Integer, total As Integer Dim aa As Integer, aaa As Integer, aaaa As Integer, bb As Integer, bbb As Integer, bbbb As Integer a = 3 '行 b = 3 '列 c = 0 内積 = 0 con = 0 sum = 0 tatal = 0 aa = 0 aaa = 0 aaaa = 0 bb = 0 bbb = 0 bbbb = 0 x = 0 For n = 0 To 2 For m = 0 To 2 For l = 0 To 2 For k = 0 To 2 For h = 0 To 2 For g = 0 To 2 For f = 0 To 2 For e = 0 To 2 For d = 0 To 2 '要素がすべて1 For i = 1 To a For j = 1 To b Cells(i, j) = 1 Next j Next i If bbbb = 1 Then Cells(a - 2, b - 2) = 0 ElseIf bbbb = 2 Then Cells(a - 2, b - 2) = -1 End If If bbb = 1 Then Cells(a - 1, b - 2) = 0 ElseIf bbb = 2 Then Cells(a - 1, b - 2) = -1 End If If bb = 1 Then Cells(a, b - 2) = 0 ElseIf bb = 2 Then Cells(a, b - 2) = -1 End If If aaaa = 1 Then Cells(a - 2, b - 1) = 0 ElseIf aaaa = 2 Then Cells(a - 2, b - 1) = -1 End If If aaa = 1 Then Cells(a - 1, b - 1) = 0 ElseIf aaa = 2 Then Cells(a - 1, b - 1) = -1 End If If aa = 1 Then Cells(a, b - 1) = 0 ElseIf aa = 2 Then Cells(a, b - 1) = -1 End If If total = 1 Then Cells(a - 2, b) = 0 ElseIf total = 2 Then Cells(a - 2, b) = -1 End If If sum = 1 Then Cells(a - 1, b) = 0 ElseIf sum = 2 Then Cells(a - 1, b) = -1 End If If con = 1 Then Cells(a, b) = 0 ElseIf con = 2 Then Cells(a, b) = -1 End If con = con + 1 Next d con = 0 sum = sum + 1 Next e sum = 0 total = total + 1 Next f total = 0 aa = aa + 1 Next g aa= 0 aaa = aaa + 1 Next h aaa = 0 aaaa = aaaa + 1 Next k aaaa = 0 bb = bb + 1 Next l bb = 0 bbb = bbb + 1 Next m bbb = 0 bbbb = bbbb + 1 Next n End Sub

  • VBAでDateaddの日付計算で困っていることがあるので助けていただけないでしょうか。よろしくお願いします。

    シート: A列には”注射”という文字を入れるようにします。 B列には1月1日から12月31日まで入っています。 C列はB列の90日後を入れるようにします。 D列はC列の3日前を入れます。・・・としたいのですがその3日の間A列に”注射”が入っていたらその日を入れずに3日前にしたいのです。 稼働日みたいな感じでしょうか・・・・ どうしたらよいでしょうか?お願いします。 例えば、B列の「1月1日」の90日後はC列「3月31日」でD列は通常「3月28日」が入っていますがB列「3月30日」の左のA列に”注射”があったらそこを無視して「3月27日」と入れたいのです。 Sub count() Dim i As Long Dim lastrow As Long lastrow = Range("B1").End(xlDown).Row For i = 1 To lastrow Cells(i, 3).Value = DateAdd("d", 90, Cells(i, 2).Value) Next For i = 1 To lastrow Cells(i, 4).Value = DateAdd("d", -3, Cells(i, 3).Value) Next End Sub 説明が下手なのでもしよかったら実際作ったものを見ていただいた方が分かるかもしれません。 http://briefcase.yahoo.co.jp/bc/robert_kubica_bmw/vwp2?.tok=bcf8oGbB4FXgt88k&.dir=/&.dnm=1count.xls&.src=bc

  • 【Excel VBA】日付の代入

    現在以下の操作を行いたく、コードを作成しています。 ・20~23行で各最大値を抽出し、C列に代入する ・最大値に紐づく日付をD列に代入する ・D列の日付が入ったセルを改行し、 2行目に"(曜日)"を入力する <現在のExcelデータ詳細> A20:"処理1" A21:"処理2" A22:"処理3" A23:"処理4" B19~AF19:日付 B20~AF23:任意の数字 C31:処理1の最大値 C33:処理2の最大値 C35:処理3の最大値 C37:処理4の最大値 D31、D33、D35、D37:日付 L(曜日)を入力予定 最大値に紐づく日付をD列に代入するところで 躓いています。 ご教示いただけないでしょうか。 現在のコードは下記の通りです。 Sub 最大値の取得() Dim max As Long Dim row As Integer Dim column As Integer For row = 20 To 23 max = 0 For column = 2 To 32 If Cells(row, column).Value > max Then max = Cells(row, column).Value End If Next Cells((row - 20) * 2 + 31, 3).Value = max For i = 4 To 1 Step -4 '編集中 Cells((row - 20) * 2 + 31, 4).Value = Cells(row - i, column - 1) '編集中 Next End Sub

  • 制御方法について

    所属名毎にシートを作成し都道府県と所属名が一致したら集計させループさせたいのですがうまくいきません。 データには列135に所属名があり139に都道府県が入っています。 解約シートには6行目5列目から都道府県名が入っています。 最終が沖縄となるので沖縄が入れば抜けるようになっています。 今の状態で実行すると所属名の数毎、都道府県の件数を更にを集計してしまいます。 一度シートを作成した所属はFor~Nextを読み込まないようにしたいのですが 自分なりに制御させようと試みましたが上手く集計されません。 何かアドバイス等ありましたらお願いします。 Dim ingcnt As Integer Dim intHjn As Integer Dim strhjn As String Dim Areastrhjn As String Dim list_cnt As Integer Dim Arealist_cnt As Integer Dim (2) As Worksheet Dim Area_cnt As Integer With Worksheets("解約データ") Set (2) = Sheets("解約・所属別") list_cnt = 2 strhjn = "" Area_cnt = 5 '所属CD1毎のシート作成 Do While Trim$(.Cells(list_cnt, 1)) <> "" '(A列)が空白でない限り繰り返す If strhjn <> .Cells(list_cnt, 135) Then strhjn = .Cells(list_cnt, 135) Sheets("解約").Select Sheets("解約").Copy Before:=Sheets("解約") Sheets("解約(2)").Name = strhjn ActiveSheet.Cells(1, 15) = strhjn End If For Area_cnt = 5 To (2).Cells(6, (2).Columns.Count).End(xlToLeft).Column Area = (2).Cells(6, Area_cnt) Arealist_cnt = 2 Areastrhjn = "" Do While Trim$(.Cells(Arealist_cnt, 1)) <> "" '(A列)が空白でない限り繰り返す Areastrhjn = .Cells(Arealist_cnt, 135) 'エリア集計 If Areastrhjn = .Cells(Arealist_cnt, 135) And _ .Cells(Arealist_cnt, 139) = Area Then ActiveSheet.Cells(7, Area_cnt) = ActiveSheet.Cells(7, Area_cnt) + 1 End If Arealist_cnt = Arealist_cnt + 1 Loop If Area = "沖縄" Then Exit For Next list_cnt = list_cnt + 1 Loop End With End Sub

  • VBA Do~Loopについて

    VBA勉強中です。 マクロの作成は完了しているのですが、処理効率について指摘を受け、 その際に助言もいただいたのですが、自身の勉強不足、理解不足で どのように変更すれば良いのか分からず、教えていただきたいです。 Do While Ax2 <= 30 で30回繰り返すのではなく (Cells(Ax2,"B").Value <> "" ) の間繰り返すように変更したいです。 ---------------- Sub test()  Dim File1(30) As string  Dim Sheet1(30) As string  Dim Sheet2(30) As string  Dim Cnt As Integer  Ax1=1  Ax2=7  Do While Ax2 <= 30    If Cells(Ax2, "B").Value <> "" Then     File1(Ax1) = Cells(Ax2, "B").Value     Sheet1(Ax1) = Cells(Ax2, "C").Value     Sheet2(Ax1) = Cells(Ax2, "D").Value     Cnt =Ax1    End If    Ax1 = Ax1 + 1    Ax2 = Ax2 + 1  Loop End Sub ---------------- お手数ですが、よろしくお願いいたします。

  • VBAで統計プログラムを作成しています。

    現在VBA(Excel)にて統計のプログラムを作成しています。 Sheet2に統計表 統計対象のシートはシートタブの色が赤色(枚数不特定) 統計表の縦軸には、B4~15に4~3(1年度の月)。横軸にはF~J4に1~5。 統計対象シートの構成は同じで セルE4に1~5の数字のどれか セルE24には1~12の数字のどれかが入ります 統計表イメージ A    B    C    D 1    1    2    3 2 4月 3 5月 4 6月 5 7月 入力画面(シート名部分赤シート) E4 ←1~5のどれか E24 ←1~12のどれか この場合において、たとえばE4が"1"、E24が"4"だった場合 統計表のB2にカウントされるというプログラムが作りたいのですが、 Option Explicit Private Sub CommandButton2_Click() Dim Ws As Worksheet Dim cnt As Variant Dim grade() As Variant 'grade = grd = 学年 grade = Array("1", "2", "3", "4", "5") Dim month() As Variant 'month = mnt = 月 month = Array("4", "5", "6", "7", "8", "9", "10", "11", "12", "1", "2", "3") Dim grd As Integer '各変数宣言 Dim mnt As Integer Dim set1 As Integer Dim set2 As Integer Dim 月ー所 As Worksheet For grd = 1 To 5 If Cells(4, 5).Value = grade(grd - 1) Then cnt = 0 set1 = grd + 5 End If For mnt = 1 To 12 If Cells(24, 5).Value = month(mnt - 1) Then set2 = mnt + 3 End If   For Each Ws In Worksheets If Ws.Tab.ColorIndex = red Then cnt = cnt + 1 End If Next Worksheets("月ー所").Cells(set2, set1).Value = cnt ←この行でエラー1004 Next mnt Next grd MsgBox "統計しました。" End Sub 矢印で示した行のエラー1004の解除方法が分からず悩んでいます どうかよろしくお願いいたします。