[[20160315084558]] 『月の間隔を数えたい』(Lila) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『月の間隔を数えたい』(Lila)

いつもお世話になっております。
設置月から数えて何ヶ月目に部品の交換をしているか、その後何ヶ月で再び交換しているかの月数を数えたいのですが、お力をお貸しください。

*やりたい事*
・設置日(C10〜)から何ヶ月目に交換しているか(0以外の数値が入っているか)
・交換日から何ヶ月目に再交換しているか(0以外の数値が入っているか)
・1〜12(数値は未定だが1年分ほどを予定)の数値を入れた列の下に上記の何ヶ月目かを加算(値が1でもそれ以外でも1つづつ加算※4ヶ月目に【2】個交換していたら【4】の下に【1】と表示し、その後再び4ヵ月後に【1】個交換していたら【4】の下に【2】と加算していく)

【表の一部レイアウト】

     |[S]      |[T]      |[U]      |[V]      |[W]      |[X]      |[Y]      |[Z]      |[AA]      |[AB]      |[AC]      |[AD]     
 [9] |2013年2月|2013年3月|2013年4月|2013年5月|2013年6月|2013年7月|2013年8月|2013年9月|2013年10月|2013年11月|2013年12月|2014年1月
 [10]|        0|        0|        0|        0|        0|        1|        0|        0|         0|         0|         0|        2
 [11]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [12]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [13]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [14]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [15]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [16]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [17]|        0|        3|        0|        0|        1|        0|        1|        0|         0|         0|         2|        0
 [18]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [19]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [20]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [21]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [22]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [23]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [24]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [25]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [26]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [27]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [28]|        0|        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [29]|         |        0|        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [30]|         |         |        0|        0|        0|        0|        0|        0|         0|         0|         0|        0
 [31]|         |         |         |         |         |        0|        0|        0|         0|         0|         0|        0
 [32]|         |         |         |         |         |         |        0|        1|         0|         0|         1|        0

まず、以下のVBAでは、最初の交換までは数えることが出来たのですが、その後その後ろを数えずに次の行に行ってしまいます。(書き出しもアクティブになったセルにされるだけ)

【Sub seeksetupdayroop()

'該当するC列のセルを選択してから実行する場合
'→Activecellからの相対位置に注意

    Application.EnableEvents = False 'イベントの禁止
    Application.ScreenUpdating = False

    Dim loopcnt As Integer
    Dim ZeroCnt As Integer

    ZeroCnt = 0
    For loopcnt = 1 To 90
        If (Int(ActiveCell.Cells(1, loopcnt + 1).Font.ColorIndex = 8)) Then
            Exit For
        End If
        ZeroCnt = ZeroCnt + 1

        DoEvents

    Next loopcnt
    ActiveCell.Cells(1, 1) = ZeroCnt

End Sub

Sub seeksetupdayentry()

    Dim loopcnt As Integer

    Do

        Call seeksetupdayroop

        ActiveCell.Cells(2, 1).Select
        If (ActiveCell.Cells(1, 2).Value = "") Then Exit Do
    Loop

End Sub】

そこで、まず、数値部分を配列に入れれば良いのかな?と思い、配列を組み込んでみたのですが「Integer」の変数箇所でエラーが出てしまいます・・・。
「Integer」は単一でしか使用できない等の制限があるのでしょうか・・・?
また、再交換を数える際の条件式?が良く判りません・・・
「後ろに数値があれば(0含む)計算を続ける」のような処理は何文を使用すればできるのか、ご教示お願い致します。
よろしくお願いします。

【Sub test1()

Dim i As Long
Dim j As Long
Dim buf As Long
Dim C As Variant
Dim ZeroCut As Integer

Set ZeroCut = 0
C = Range("S10:BC10000")
For i = 1 To 10000
For j = 1 To 100
buf = C(i, j)
If (Int(Cells(buf).Font.ColorIndex = 8)) Then
Else

Exit For
End If
Next j
Next i
ZeroCut = ZeroCut + 1

DoEvents

ActiveCell.Cells(1, 1) = ZeroCnt

End Sub

Sub test2()

Do
Call test1

ActiveCell.Cells(2, 1).Select
If (ActiveCell.Cells(1, 2).Value = "") Then Exit Do
Loop

End Sub】

< 使用 Excel:Excel2013、使用 OS:Windows7 >


 要件やコードは詳細に読んでいませんが、まず、コードにはインデントを付けましょうね。

 Sub test1()

    Dim i As Long
    Dim j As Long
    Dim buf As Long
    Dim C As Variant
    Dim ZeroCut As Integer

    Set ZeroCut = 0
    C = Range("S10:BC10000")
    For i = 1 To 10000
        For j = 1 To 100
            buf = C(i, j)
            If (Int(Cells(buf).Font.ColorIndex = 8)) Then
            Else
                Exit For
            End If
        Next j
    Next i
    ZeroCut = ZeroCut + 1

    DoEvents

    ActiveCell.Cells(1, 1) = ZeroCnt

 End Sub

 このほうが、ずっと読みやすいと思いませんか?

 で、本題。

 C = Range("S10:BC10000")

 これは、S10:BC10000 の内容を、配列として格納しますね。
 S10:BC10000 というのは、どんな大きさでしょう?
 行が 10〜10000 ですから、9991 行ですね。
 列は S列からBC列ですから、37列 になりますね。

 そうすると、配列 C は 行の要素として 1 To 9991、列の要素として 1 To 37 になります。
 その配列に対して 行ループ 1 To 10000、列ループ 1 To 100 は、途中にある Exit For で強制脱出するケースの前に処理されると
 配列のインデックスマックス値を超えてしまいますよね。

(β) 2016/03/15(火) 10:35


>βさん

すいません;
一旦メモ帳に書いて、貼り付けていたので、インデント入れ忘れてしまいました。
ご指摘箇所を修正しましたが「Set ZeroCut = 0」この箇所で「オブジェクトが必要です」とエラーが出てしまうのですが・・・「Integer」を「Long」にしてみても同じでした・・・
(Lila) 2016/03/15(火) 11:33


 Set は オブジェクト変数に オブジェクトを格納するときに使います。
 Integer型の変数に 0 をいれるのですから、単純に ZeroCut = 0 です。

 で、このZeroCut という変数は、 Dim ZeroCut As Integer と規定した時点で 値が 0 になっています。
 でしから、そもそも、このコード自体が不要ですね。

(β) 2016/03/15(火) 21:24


>βさん

宣言した時点で0になるのですね!
ありがとうございます。
「 Set ZeroCut = 0」ここを削除すると今度は、「ActiveCell.Cells(1, 1) = ZeroCnt」のZeroCutでコンパイルエラーが出て「変数が定義されていません」と出てしまうのですが・・・
(Lila) 2016/03/16(水) 08:28


 >>ActiveCell.Cells(1, 1) = ZeroCnt

 ActiveCell.Cells(1, 1) = ZeroCut  でしょ?

(β) 2016/03/16(水) 08:46


 こんにちは。
 横から失礼します。

 >「ActiveCell.Cells(1, 1) = ZeroCnt」のZeroCutでコンパイルエラーが出て「変数が定義されていません」と出てしまう
 ご説明に ZeroCnt と ZeroCut が混在していますが、実際のコードはどうですか。
 いずれにしても、「そんな変数知らない(大意)」というエラーなら、
 本当にないのか検索してみてはどうでしょう。
 Ctrl + F で検索用のダイアログボックスが出てきます。 

 あと、ためしに、ないといわれる変数を宣言してみてエクセル君の反応が変わるか
 見てみるという手もあります。

 >「Integer」は単一でしか使用できない等の制限があるのでしょうか・・・? 
 それだけを単独で試してみれば分かるじゃないですか(^^
 簡単に確認できる(はずの)ことを質問しちゃいけませんって。 

 ただ、最初にご提示のコードでは、Integer型の配列はないので、
 つまり「Integer」は単一でしか使用していないので(って意味ですよね?)
 制限とか関係ないと思えるのですけど。

 バグ取りをするときは、あやしいことうたがわしいことは、ひとつずつ
 つぶしていくのです。どんどんつぶして、どうしてもつぶせず残ったものが真犯人です。
 たとえどれほどありえないことに思われたとしても、それが真犯人です。
 ...とシャーロック・ホームズが言っていたと、コナン君が言っていました。

( 佳 ) 2016/03/16(水) 09:07


>βさん
あぁ・・・;
今、何が違うんだろう・・・と思っていたらなるほど・・・「u」が「n」になっていたからですね・・・
お恥ずかしい・・・

今度はまた別のところでオブジェクト定義のエラーが出たので、ちょっとスペル見直してみます。

条件分岐の所なのですが、「設置月(日)から見て初めて「0」以外の数値があった箇所の次に0を含む数値が入っていたら処理を続行する、という命令はどう入れたら良いのでしょう?
「Else」で大丈夫なのでしょうか・・・?

>佳さん
ありがとうございます。
やってみます^^
(Lila) 2016/03/16(水) 09:11


 >>「設置月(日)から見て初めて「0」以外の数値があった箇所の次に0を含む数値が入っていたら処理を続行する、
 >>という命令はどう入れたら良いのでしょう?  「Else」で大丈夫なのでしょうか・・・? 

 回答したいのですが、何をどうしようとしているのかがわからないので、ちょっと悩んでいます。

 1.まず、アップされたコード、セルの値ではなく、背景色をチェックしていますね?
   その理由は?

 2.C10の設置日をベースに 1,2,3,4,・・・ヵ月目の欄に記載するとして、この記載欄はどこにあるのですか?

(β) 2016/03/16(水) 13:40


 もう1つ。
 もし設置月に交換が行われた場合、0ヵ月 ですか 1ヵ月 ですか?

(β) 2016/03/16(水) 14:00


>βさん

1.ベースは私が作ったものではないので(私は配列に入れたら良いのではないかな?とそこを試している所です)すが、背景色を指定しているというのはアップした表のレイアウト部分が「カラースケール」で色分けされており、設置月部分に水色の罫線で枠にしてあるからです。

2.すみません、記載忘れていました。BF列〜BR列の9行目に(実際は12ヶ月以上もある場合もありますが、とりあえず)「0〜12」までを記入してあります。

3.もしも設置月の交換があった場合は「0」の下にその数値が1以上であっても「1」が入ります。
(Lila) 2016/03/16(水) 14:17


 >BF列〜BR列の9行目

 この回答をもらう前に書いてしまいましたので、とりあえずコードをアップします。
 (要件を想像しまくっていますので誤解あるかも)
 結果は Sheet2 に展開しています。

 Sub Test()
    Const MYTERM As Long = 12   '分析月数
    Dim rep(0 To MYTERM + 1, 1 To 1) As Long
    Dim c As Range
    Dim r As Range
    Dim head As Range
    Dim body As Range
    Dim line As Range
    Dim install As Range
    Dim j As Long
    Dim n As Long
    Dim d1 As Date
    Dim d2 As Date
    Application.ScreenUpdating = False

    With Sheets("Sheet1")   '★元シート
        Set install = .Range("C10", .Range("C" & Rows.Count).End(xlUp))
        Set head = .Range("S9", .Range("S9").End(xlToRight))
        Set body = .Range("S10").Resize(install.Rows.Count, head.Columns.Count)
    End With
    For Each r In install
        Set line = Intersect(r.EntireRow, body)
        d1 = r.Value
        For Each c In line
            If c.Value <> 0 Then
                d2 = Intersect(c.EntireColumn, head).Value
                n = DateDiff("m", d1, d2)
                If n < 1 Then
                    n = 0
                ElseIf n > MYTERM Then
                    n = MYTERM + 1
                End If
                rep(n, 1) = rep(n, 1) + 1
                d1 = d2
            End If
        Next
    Next

    With Sheets("Sheet2")   '★転記シート
        .Cells.ClearContents
        .Range("A1:B1").Value = Array("月数", "交換回数")
        .Range("A2").Value = 0
        .Range("A2").Resize(MYTERM + 1).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
        .Range("A2").Offset(MYTERM + 1).Value = MYTERM & "ヵ月超"
        .Range("B2").Resize(MYTERM + 2).Value = rep
        .Select
    End With

 End Sub

(β) 2016/03/16(水) 14:30


>βさん

ありがとうございます><
早速試してみました。

質問なのですが
>>d2 = Intersect(c.EntireColumn, head).Value
この部分の「d2」はC列を見ているので合っていますか?
それとも、9行目の「20○○年○月」の方でしょうか。
「d2」=「2015/09/01」が入っていたので、恐らく後者かなと思ったのですが、この場合日付(Date型で間違いないと思うのですが、型が一致しませんのエラーが出てしまいました。
引用データ数が多いので、テスト段階では減らしていて、この「2015年9月」の列(AX列)から1や2の数値が入っているのですが、何か関係ありますか・・・?(2013年2月〜2015年8月までは設置日からずらっと「0」が入っている状態)
(Lila) 2016/03/16(水) 15:15


 構成としては S10から始まる各行に対する設置日を、その行の C列(10行目であれば C10)から d1 にいれます。
 で、その行の各セルで 0 ではないセルの列の 9行目の値を d2 にいれ、d1 と d2 の月差を判定します。
 そのあと、d1 を d2 で入れ替えます。つまり、この行の、その次の 0 ではないセルのd2 については、比較対象が
 入れ替えられた d1 すなわち、このセルの前に現れた交換月になります。

 いずれにしても、C10:C● の値が 正しい日付型、S9から右に伸びる交換日も正しい日付型であれば、
 型が違うというエラーにはならないはずです。
 ただし、S9から右の交換日が、どこまであるか、これは、固定ではなく、S9から右にみてデータが存在する最終列までとしています。
 ですから、たとえば、S9:AX9 が日付だとして、AY9に何か値があればそこも交換日付だと認識します。
 そこが、文字列になっていれば、型が違うというエラーになりますね。

 実際の、日付の右のほうのシートの状況はどうなっていますか?

 d2 = Intersect(c.EntireColumn, head).Value

 ここでエラーになった時点で、その下に

 MsgBox Intersect(c.EntireColumn, head).Address(External:=True) 

 これを追加し、実行させてみてください。どんなセルアドレスが表示されますか?
 で、そこは、どんなセルですか?

(β) 2016/03/16(水) 17:11


 ↑ というか、

 Set head = .Range("S9", .Range("S9").End(xlToRight))

 このあとに MsgBox head.Address(External:=True) といれてみて確認してください。

(β) 2016/03/16(水) 17:35


 もう1つ気になる点。
 シートの日付列(C列)や日付行(9行目)、ここは、数式なんかで入っているということはありますか?
 アップしたコードは、数式による空白("")は対応していません。
 もし数式で入っていて、数式による"" があるということであれば、それなりに変更しますけど。

(β) 2016/03/16(水) 19:10


>βさん

おはようございます。

まず
>(β) 2016/03/16(水) 17:11
の結果は「AX9〜BA9」の繰り返しでした。
セル値は「2015年9月(2015/09/01)」〜「2015年12月(2015/12/01)」で、書式設定的には「ユーザー定義」です。

>(β) 2016/03/16(水) 17:35
の結果は「S9〜BD9」でした。
セル値は「S9〜BC9」までは上記と同じ設定での日付です。
ですが「BD9」は文字が入っていたので、それが原因かなと思い、削除して実行してみましたら、今度は
 > d1 = r.Value
ここで同様の「型が一致しません」のエラーが発生してしまいました・・・;

>(β) 2016/03/16(水) 19:10
こちらの方は、数式や関数ではないです。
C列には、10行目から190行目まで空白はありません。
(Lila) 2016/03/17(木) 08:31


 9行目のエラーについては解決ですね。
 もし、9行目の日付欄が S:BC に決まっている(必ず、ここには日付がある)なら

        Set head = .Range("S9", .Range("S9").End(xlToRight))
        Set body = .Range("S10").Resize(install.Rows.Count, head.Columns.Count)

 これを

        Set head = .Range("S9:BC9")
        Set body = .Range("S10:BC10").Resize(install.Rows.Count)

 こうしておいたほうがいいですね。そうすれば BD9に何が入っていてもOKです。

 >>d1 = r.Value

 一難去って、また一難 ですね。C列の最終セルを xlUp で求めています。
 C列の日付、190行目まであるということですが、その下のC列に何か文字が入っているということはないですか?
 エラーが発生した時点で、イミディエイトウィンドウに
 ?r.Address や ?r.Value と打ち込んでエンターすると、どんな値が表示されますか?

(β) 2016/03/17(木) 08:49


>βさん

無事、動きました^o^
ありがとうございます。

>> d1 = r.Value
>ここで同様の「型が一致しません」のエラーが発生してしまいました・・・;
このエラーは、仰る通り、余計なデータが下の方に潜んでいたので、削除しました。
そうしたら無事に結果が出力されました!

結果についてなのですが、全体の結果で出てしまっているので、商品ごとの交換サイクルを知りたい案件である為、これを行ごとに出したいのです。
私の説明が良く解り難かったですね。申し訳ないです・・・;

(Lila) 2016/03/17(木) 09:06


 つまり、行ごとに、BFから右にセットするということですね。

 ・BF9から月数が横に入っていると思いますが、必ず 0 から始まる連番と考えていいですか?
  それとも、0,1,5,3,・・・と飛んでいたり、順序が逆になっているということはありますか?
 ・何個規定されているかは自動取得でいいですか? その場合 9行目の最後の月の右には何も入っていないと考えていいですか?
 ・コード内で(アップしているコードがやっているように)分析対象月を規定して、コード内で 9行目のBF列から右に月を自動セットしてもいいですが。

 まぁ、コードは書き始めますので、その前に回答あれば反映します。
 間に合わなければ、最後の方式、コード内で規定して自動セットでいきます。

(β) 2016/03/17(木) 10:46


>βさん

>>つまり、行ごとに、BFから右にセットするということですね。
そうですね!
そのようになります。

>>BF9から月数が横に入っていると思いますが、必ず 0 から始まる連番と考えていいですか?
はい。BF9〜BR9に順番に0,1,2,3,4〜12と入力しています。
BS9に「12ヶ月超」の欄も作成しようと思います。

>>それとも、0,1,5,3,・・・と飛んでいたり、順序が逆になっているということはありますか?
今の所、その必要性が無い上、見難いと思うので順番どおりです。

>>何個規定されているかは自動取得でいいですか? その場合 9行目の最後の月の右には何も入っていないと考えていいですか?
これはS9からBC9の間で、いくつあるかを自動取得、という事でしょうか?
最後の月の右の列(現在はBD9)は、現在は何も入って居ません。
今後何かを入れるとしても、日付が増えるだけかな?と思います。

よろしくお願いします。
(Lila) 2016/03/17(木) 10:59


 何か月分を分析するかはコード内で規定する方式です。
 9行目は自動設定します。

 Sub Test2()

    Const MYTERM As Long = 12   '★分析月数

    Dim rep As Variant
    Dim c As Range
    Dim r As Range
    Dim head As Range
    Dim body As Range
    Dim line As Range
    Dim install As Range
    Dim j As Long
    Dim n As Long
    Dim d1 As Date
    Dim d2 As Date
    Dim x As Long

    Application.ScreenUpdating = False

    With Sheets("Sheet1")   '★元シート

        Set install = .Range("C10", .Range("C" & Rows.Count).End(xlUp))
        Set head = .Range("S9:BC9")
        Set body = .Range("S10:BC10").Resize(install.Rows.Count)
        ReDim rep(1 To body.Rows.Count, 0 To MYTERM + 1)
        For Each r In install
            x = x + 1
            Set line = Intersect(r.EntireRow, body)
            d1 = r.Value
            For Each c In line
                If c.Value <> 0 Then
                    d2 = Intersect(c.EntireColumn, head).Value
                    n = DateDiff("m", d1, d2)
                    If n < 1 Then
                        n = 0
                    ElseIf n > MYTERM Then
                        n = MYTERM
                    End If
                    rep(x, n) = rep(x, n) + 1
                    d1 = d2
                End If
            Next
        Next

        .Range("BF9").Value = 0
        With .Range("BF9").Resize(, MYTERM + 1)
            .DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
            .NumberFormatLocal = "0""ヵ月"""
        End With
        .Range("BF9").Offset(, MYTERM + 1).Value = MYTERM & "ヵ月超"
        .Range("BF10").Resize(UBound(rep, 1), MYTERM + 2).Value = rep

    End With

 End Sub

(β) 2016/03/17(木) 11:01


>βさん
ありがとうございます><

>For Each c In line
この部分で再び「オブジェクトが必要です」エラーが出力されてしまいました・・・。
cはデータ行を見ているのでしょうか??
(Lila) 2016/03/17(木) 16:13


 なかなか、すっとはいきませんねぇ・・・

 line は、body つまり S10:BC● のなかの 各行です。

 Set line = Intersect(r.EntireRow, body)

 ここで取得しています。このオブジェクトがないということは、結果が Nothing だったということですが
 それは、基本的にはないはずです。(シートの内容がこちらで想定しているものならば)

 ReDim rep(1 To body.Rows.Count, 0 To MYTERM + 1)

 この下に、

 MsgBox install.Address & vblf & body.address

 これをいれて、表示される C列の日付領域と S10:BC● の領域が正しいかどうか確認してください。

 ★もちろん、最後までお手伝いしますが、領域がおかしいという場合は、その領域がどうなっているかを
  調べるのが早いですよ。想定外の領域になっていれば、思わぬところのセルに値(ごみ)が入っていて
  そこまでが対象になってしまっているとか、いろいろありますので。

(β) 2016/03/17(木) 17:54


>βさん

ありがとうございます。
連休明けになってしまいますが、確認してみます!
(Lila) 2016/03/18(金) 10:56


>βさん

おはようございます。
指定のコードを入れて調べた所

日付領域が $C$1:$C$10
データ領域が $S$10:$BC$19

と出力されました。
日付がS9〜BC9に設定されているので、それ以外の文字データが入ってしまっているのが原因でしょうか・・・?
データ領域も
>Set install = .Range("C10", .Range("C" & Rows.Count).End(xlUp))
ここで、最終行を拾っているはず・・・だと思っているのですが(合っていますか?)、何故か19行目までになってしまっているようです??
(Ctrl+↓では現在データの入っている最終行の190行目まで飛びます。)

(Lila) 2016/03/22(火) 08:46


 まず、日付欄(コードでは install)が $C$1:$C$10 !!

 これは、Set install = .Range("C10", .Range("C" & Rows.Count).End(xlUp)) で取得していますが
 本来は C10:C19 なり C10:C190 なり、いずれにしても C10 から【下】の領域になるはずです。

 それが、C1:C10 になったということは、.Range("C" & Rows.Count).End(xlUp) が C1 だった、つまり C列が完全な空白列だったといことです。
 そちらでは C10 から下に 設置日が入っているんですよね?

 で、本来、$S$10:$BC$190 なのに $S$10:$BC$19 になった件はうなづけます。 
 データ領域(body) は  Set body = .Range("S10:BC10").Resize(install.Rows.Count)
 つまり、行数が、日付欄(install) の行数にしています。
 なぜか 日付欄は C1:C10 になってしまっていて、その行数は 10行ですから 10〜19 になるわけです。

 ★ポイントは、なぜ、Set install = .Range("C10", .Range("C" & Rows.Count).End(xlUp)) が $C$1:$C$10 になったのか?
  これは、こちらでは、そちらのシートが見えないのでなんとも判断がつきません。
  本当に設置日は C10を先頭に C列に記載されているのですか?

(β) 2016/03/22(火) 09:27


>βさん

> ★ポイントは、なぜ、Set install = .Range("C10", .Range("C" & Rows.Count).End(xlUp)) が $C$1:$C$10 になったのか?
> これは、こちらでは、そちらのシートが見えないのでなんとも判断がつきません。
>  本当に設置日は C10を先頭に C列に記載されているのですか?

そうですね・・・。
C列に設置日記載されていて、以前のスレッドでも読み取れない事があったと記憶しているのですが、あの時は
目視でデータが入っているのは見えているのに、Ctrl+↓又は↑が利かない(1048576まで飛んでしまう)という動きだったのですが、今回はちゃんと190で一回止まり、その後もう一度押すと1048576に飛びます・・・。

C列までのレイアウトを数行抜き出してみました。

【C列までのレイアウト】

     |[A]                       |[B]                                                                                                                                |[C]       
 [1] |                         1|                                                                                                                                  2|         3
 [2] |※機種から検索情報から    |                                                                                                                                   |          
 [3] |                          |                                                                                                                                   |          
 [4] |                          |↓シリアルは、2015.8.7現在 60ヶ。実際は、68-70あるが、「訪問」や「修理集計する」で漏れる模様。MTTR時間管理のため、このままで行く。|          
 [5] |対象セル列                |av                                                                                                                                 |aw        
 [6] |                          |参照域                                                                                                                             |          
 [7] |                          |                                                                                                                                   |          
 [8] |                          |                                                                                                                                   |          
 [9] |→※太字は参照先と名称共通|シリアル番号                                                                                                                       |初期設置日
 [10]|                          |H1810196                                                                                                                           |2008/12/22
 [11]|                          |H1810200                                                                                                                           |2009/1/13 
 [12]|                          |H1810201                                                                                                                           |2009/1/19 
 [13]|                          |H1909413                                                                                                                           |2009/10/2 
 [14]|                          |H1910491                                                                                                                           |2009/11/28
 [15]|                          |H1908356                                                                                                                           |2009/12/1 
 [16]|                          |H19CB560                                                                                                                           |2009/12/25
 [17]|                          |H10AB870                                                                                                                           |2010/10/8 
 [18]|                          |H10CB985                                                                                                                           |2010/12/23
 [19]|                          |H10CB987                                                                                                                           |2010/12/27
 [20]|                          |H10CB002                                                                                                                           |2011/2/9  
 [21]|                          |H10CB007                                                                                                                           |2011/2/24 
 [22]|                          |H10CB006                                                                                                                           |2011/2/28 
 [23]|                          |H116B186                                                                                                                           |2011/7/7  
 [24]|                          |H11AB319                                                                                                                           |2011/11/4 
(Lila) 2016/03/22(火) 09:42

 >>目視でデータが入っているのは見えているのに、Ctrl+↓又は↑が利かない(1048576まで飛んでしまう)という動きだったのですが

 あぁ、そういうことがありましたね。
 あれは、結局、何が原因だったんでしたっけ?

 いずれにしても、提示されたレイアウトなら、C10:C190 になるはずですよねぇ・・・

 だめもとで

         Set install = .Range("C10", .Range("C9").End(xlDown))

 にかえると、どうなりますか?(同じかなぁ・・・)

(β) 2016/03/22(火) 10:11


>βさん

> あれは、結局、何が原因だったんでしたっけ?
確か、こちらの掲示板を見つける前に別所で質問しつつ書き上げたコードがなんらかの邪魔をしていた・・・だった気がします。(これもβさんに見直していただいて正常に起動するようになったかと)

>Set install = .Range("C10", .Range("C9").End(xlDown))
こちらに変えてみたら、

$C$10:$C$1048576
$S$10:$BC$1048576

になってしまいました・・・。
が、
> For Each c In line
ここでは止まらず、最後まで動いたようです??(結果は反映されませんでしたが)
(Lila) 2016/03/22(火) 10:25


 ということは、xlDown でも、その下に何もない、なので最終行 1048576 が取得されてしまったということですね。

 不思議ですねぇ。今回は、操作で Shift/↑ や Shift/↓ の場合は、正しく機能しているわけでしから・・・

 テンキーパッドがついていて、そこの NumLockがオフになっていると、テンキーの数字を押したときに、とんでもないカーソルの動きになるわけですが
 今回のケースではあてはまらないですし・・・

 シートがグループ化されていると、悪さをするかなと、いろいろ試しましたが、問題はないですし。

 う〜ん・・・・
 提示のデータで C列に実際に存在する値が認識されない・・・・
 こんなことはないと思いますが、このシートのどこかのセルに =COUNTA(C:C) と入れてみてください。
 いくつになりますか? で、それは目に見えているC列で値の入ったセルの数と同じでしょうか?

 もし、ここで、1048576 とでれば、なんとなく原因がわかりそうです。

(β) 2016/03/22(火) 13:08


>βさん

>=COUNTA(C:C)
これを試した所、184と出ました。

うーん・・・一応、このシート内で動作している他のマクロを貼ってみます。

元々の作成者の方はどうやってC列を入れていたのか解らないのですが、今回私が使用しているデータは、下記の一番上のマクロで使用している他ブックでオートフィルタを使用して、結果をそのままコピー&ペーストしたものです。

【他ブックから部品交換した月を持ってきて、カラースケールで視覚的にわかりやすくする】

Sub collecttargetsumheadver()
'縦横ほか期間の該当の合計を集計するのヘッドVer.
'2015.9.11

    Application.EnableEvents = False                    'イベントの禁止
    Application.ScreenUpdating = False                  '画面チャタしない

    Dim i As Integer, j As Integer, s As Double

    Dim key1 As String                                  '今回は縦列 参照 シリアル番号
    Dim key2 As String                                  '今回は横行 参照 その期間月(月初日)
    Dim key3 As String                                  '今回は横行 参照 その期間月の翌月初日
    Dim bin1 As String
    Dim bin2 As String

    Dim shData As Worksheet
    Dim shTarg As Worksheet
    Set shData = Worksheets("01-01 検索")    '引用シート名
    Set shTarg = Worksheets("集計1")                       '集計シート名
    bin1 = shData.Cells(Rows.Count, 2).End(xlUp).Row
    bin2 = shTarg.Cells(Rows.Count, 2).End(xlUp).Row

        For i = 0 To bin2 - 10
            key1 = shTarg.Cells(10 + i, 2).Value       'Cells(行、列)
                For j = 18 To 53    '←ここの52の数字を月が増えたら増やすref.2015年12月=52
                    key2 = shTarg.Cells(9, j).Value
                    key3 = shTarg.Cells(9, 1 + j).Value
                        With shTarg
                            shTarg.Cells(10 + i, j) = Abs(WorksheetFunction.SumIfs(shData.Range("bi3:bi" & bin1), _
                                                                              shData.Range("au3:au" & bin1), key1, _
                                                                              shData.Range("aa3:aa" & bin1), ">=" & key2, _
                                                                              shData.Range("aa3:aa" & bin1), "<" & key3))
                        End With
                Next j
        Next i
    End Sub

【設置日に水色の罫線枠をつける】
Sub coloingframedayofsetup()

    Application.EnableEvents = False                    'イベントの禁止
    Application.ScreenUpdating = False                  '画面チャタしない

    Dim i As Integer, j As Integer, s As Double

    Dim key1 As String                                  '今回は縦列 参照 シリアル番号
    Dim key2 As String                                  '今回は横行 参照 その期間月(月初日)
    Dim key3 As String                                  '今回は横行 参照 その期間月の翌月初日
    Dim bin2 As String

    Dim shData As Worksheet
    Dim shTarg As Worksheet

' Set shData = Worksheets("01-01 機種から検索_150924") '引用シート名

    Set shTarg = Worksheets("集計1")                       '集計シート名
'    bin1 = shData.Cells(Rows.Count, 2).End(xlUp).Row
    bin2 = shTarg.Cells(Rows.Count, 2).End(xlUp).Row

    'For j = 11 To 49 'インク種と色のある位置
        'For j = 5 To 77  'EUディーラ数

        For i = 0 To bin2 - 5
            Range(Cells(10 + i, 18), Cells(10 + i, 50)).Borders.LineStyle = xlLineStyleNone     '既存水色枠のクリアフィルタ起動して順番変わった場合など
            key1 = shTarg.Cells(10 + i, 3).Value       'Cells(行、列)
                For j = 18 To 53        '←ここの52の数字を月が増えたら増やすref.2015年12月=52
                    key2 = shTarg.Cells(9, j).Value
                    key3 = shTarg.Cells(9, 1 + j).Value
                    If key1 >= key2 And key1 < key3 Then
                        With Cells(10 + i, j).Borders
                        .LineStyle = xlContinuous
                        .Weight = xlMedium
                        .ColorIndex = 8
                        End With
(Lila) 2016/03/22(火) 13:24

 なんとも不可解ですねぇ。
 どうしても、先に進まなければ、無理やり、この状況を突破する処理を加えますが、その前に。
 (強行突破が可能かどうかの確認も含んでいます)

 現在のおかしくなるブックの状態で、以下を実行して、結果を連絡してください。

 Sub 確認()
    With Sheets("Sheet1")
        MsgBox "確認1:" & vbLf & IsEmpty(.Range("C10")) & vbLf & IsEmpty(.Range("C20")) & vbLf & IsEmpty(.Range("C300")) & vbLf & _
            .Range("C" & Rows.Count).End(xlUp).Row
    End With

    With ThisWorkbook.Sheets("Sheet1")
        MsgBox "確認2:" & vbLf & IsEmpty(.Range("C10")) & vbLf & IsEmpty(.Range("C20")) & vbLf & IsEmpty(.Range("C300")) & vbLf & _
            .Range("C" & Rows.Count).End(xlUp).Row
    End With
 End Sub

(β) 2016/03/22(火) 17:52


 ちょっと気になるのですが・・・

 もし、現在使っているブックのシートが、Sub coloingframedayofsetup() で加工されたものだったとします。

 最終行を bin2 = shTarg.Cells(Rows.Count, 2).End(xlUp).Row で取得してますよね?
 これは B列の最終セルですね。
 コード内では key1 = shTarg.Cells(10 + i, 3).Value       'Cells(行、列)
 があって、C列の値を その行の R列以降の値と比較したりしていますので 設置日は C列なんだろうとは思うんですが
 いずれにしても、このシート、B列なら End(xlup) で正しい最終行が求まっているということですね?

 ★本テーマには関係ないのですが、この Sub coloingframedayofsetup() 内で、
   bin2 = shTarg.Cells(Rows.Count, 2).End(xlUp).Row
  というように、シート修飾しているコードと、Range(Cells(10 + i, 18), Cells(10 + i, 50)) 等、コード修飾していないものが混在してますね。

(β) 2016/03/22(火) 18:57


 まさかとは思いますが・・・・・

     With Sheets("Sheet1")   '★元シート

 実際のシート名は、"Sheet1" ではないと思いますので、ここは、実際のものにかえて実行してもらっていますよね・・
 もしかしたら、ここは、このままで、かつ、ブックに全く別の "Sheet1" が存在している・・

 ということはないですよねぇ・・
 (もし、そうであれば、発生している不具合の説明がつきますので、ふと・・でも、そんなことはないですよねぇ・・)

(β) 2016/03/22(火) 19:05


>βさん

>もし、現在使っているブックのシートが、Sub coloingframedayofsetup() で加工されたものだったとします。

 最終行を bin2 = shTarg.Cells(Rows.Count, 2).End(xlUp).Row で取得してますよね?
 これは B列の最終セルですね。
 コード内では key1 = shTarg.Cells(10 + i, 3).Value       'Cells(行、列)
 があって、C列の値を その行の R列以降の値と比較したりしていますので 設置日は C列なんだろうとは思うんですが
 いずれにしても、このシート、B列なら End(xlup) で正しい最終行が求まっているということですね?

確かに、B列で見ていますね。
シリアルコードも全てうまっているので、見る場所をB列にしてみると解決するかもしれないですね!

いずれにせよ
>(β) 2016/03/22(火) 17:52
の確認も含め、見てみます。
(Lila) 2016/03/22(火) 20:14


> With Sheets("Sheet1") '★元シート

ここはもちろん修正しています。

(Lila) 2016/03/22(火) 20:17


 調査の合間に、新規ブックで 以下を実行して、マクロ実行に必要なイメージをSheet1に作り出し、その上で
 Test2 を実行してみていただけますか?

 Sub DataGen()
    Dim w As Variant
    Dim i As Long
    Dim j As Long
    Dim x As Long

    Cells.ClearContents

    w = Range("S10:BC32").Value

    For i = LBound(w, 1) To UBound(w, 1)
        For j = LBound(w, 2) To UBound(w, 2)
            x = Int(50 * Rnd + 1)
            If x > 3 Then x = 0
            w(i, j) = x
        Next
    Next

    Range("S10:BC32").Value = w

    Range("C9").Value = "初期設置日"
    Range("C10") = "2013/1/1"
    Range("C10:C32").DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
        xlDay, Step:=1, Trend:=False

    Range("S9") = "2013年2月"
    Range("S9:BC9").DataSeries Rowcol:=xlRows, Type:=xlChronological, Date:=xlMonth _
        , Step:=1, Trend:=False

 End Sub

(β) 2016/03/23(水) 09:29


おはようございます。

新規ブックでそのまま実行すればいいのですか??
(Lila) 2016/03/23(水) 09:41


>βさん

新規ブックで実行した後、test2を実行した所、12か月以上の集計は出来ませんでしたが、その他の集計はできました!

(Lila) 2016/03/23(水) 18:15


>βさん

>(β) 2016/03/22(火) 17:52
こちらの方の結果ですが

True
True
True
1

となりました。
(Lila) 2016/03/24(木) 13:04


 報告深謝。

 2回メッセージがでているはずですが、いずれも True,True,True,1 だったということですね?

 ますます奇奇怪怪ですねぇ。

 メッセージで表示された4つの情報は

 IsEmpty(.Range("C10")) これが True つまり、空白。(データはあるんですよね?)
 IsEmpty(.Range("C20")) これが True つまり、空白。(データはあるんですよね?)
 IsEmpty(.Range("C300")) これが True つまり、空白。(これは、あたりませですよね。C300 には日付は入っていないでしょうから)
 .Range("C" & Rows.Count).End(xlUp).Row これが、 1。つまり、C列には値が(少なくとも C1 以外は)入っていない。

 こういう結果ですね。

 う〜ん・・・目視では C10 にも C20 にも 何かしら入っているのですよね?
 で、Ctrl/↓ ではん、ちゃんと、思ったところで止まるんですよね?

 (β) 2016/03/23(水) 09:29 で作り上げたシートに対しては(12月超は別にして)ちゃんと C列のデータ最終行は把握できていますよね?
 同じコードを、そちらの実際にシートで走らせると、不可思議な状態。

 マクロで見ているシート、別の空白シートを見ているとしか思えないのですが・・・

 もし、確認 で出てくる最初が、報告された内容で、2回目にでてきたものが、そうではないなら
 思い当るところはあるのですが?

(β) 2016/03/24(木) 17:28


>βさん

そうですね、2回とも同じ結果でした。

> う〜ん・・・目視では C10 にも C20 にも 何かしら入っているのですよね?
> で、Ctrl/↓ ではん、ちゃんと、思ったところで止まるんですよね?

そうですね…
C10にもC20にも入っていますし、Ctrl/↓ではC1からした場合、C4→C9→C190→C1048576で止まります。

もう一度シート名をしっかり確認してみます。
(Lila) 2016/03/24(木) 19:32


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.