質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

89.21%

For ~ Next 繰返し処理の最後で意図しない値を得てしまいます。

解決済

回答 4

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 2,129
    Dim p As Integer
    Dim yearF As Integer
p = 3
    Worksheets("list").Select
    For p = 3 To WorksheetFunction.CountA(Range(Range("f3"), Cells(Rows.Count, 6).End(xlUp))) + 2
        yearF = Range("f" & p).Value
    Debug.Print "F:" & p & " , " & yearF
            If WorksheetFunction.CountIf(Worksheets("年間集計").Range("7:7"), yearF) = 0 Then
                With Worksheets("年間集計").Range("e7:e" & Cells(Rows.Count, 5).End(xlUp).Row)
                    .Copy
                    .Insert xlShiftToRight, copyorigin:=xlFormatFromRightOrBelow
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteFormats
                End With
                Worksheets("年間集計").Range("e7").Value = yearF '?1つだけ空になる■
            End If
    Next p

「list」シートからyearFを上から繰返し読込しています。
イメージ説明

最後F5の際、p=5になっているのになぜかyearF=0となり、結果西暦年が0の列ができてしまします。
イメージ説明

デバッグでF8ステップ実行しても結果は変わりません。

お知恵を拝借できますと幸いです。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • yuki-saito

    2017/10/26 11:07

    回答しようと色々読んで察そうとしてみたのですが、添付してくださっている画像に列番号(Fなど)や行番号がないので分かりませんでした。そこが分かるようにしてもられば何かお答えできるかもしれません。

    キャンセル

  • vitabrevisarsl1

    2017/10/26 13:41

    ・画像差し替えてみました。

    キャンセル

回答 4

+1

既に解決済みのようですが、疑問が残っているようでしたので投稿させていただきます。
(といってもハズしているかもしれませんが、参考までに。)

本題に入る前に1つ確認なのですが、年間集計シートで「年」の表示は7行目の上なので6行目のように見えますが、ソースコードでは7行目に出力しているようですね。
ここはソースコードが正しい(7行目に「年」を出力)ものとして話を進めさせていただきます。

原因?

実際に動作させたわけではないのでハズしているかもしれませんが、yearFを取得する際に対象シートを明示していないのが気になります。
対象シートを明示していないと暗黙的にアクティブシートが対象となります。
ループ処理に入る前にlistシートをアクティブにしていますが、ループ処理中にアクティブなシートが切り替わったりすると、例えば年間集計シートのF列の値をとってしまうかもしれません。

対応

これが原因であればyearF =  Worksheets("list").Range("F:" & p).Valueのようにシートを明示することで改善するかもしれません。
また、これ以外にも対象シートを明示していない部分が見受けられますので、あわせて明示することをオススメします。

以下、上記内容も含めて整理したサンプルソースになります。

    Dim shtList As WorkSheet
    Dim shtSummary As WorkSheet

    Set shtList = Worksheets("list")
    Set shtSummary = Worksheets("年間集計")

    Dim p As Integer
    Dim yearF As Integer

    'listシートのF列3行目~最終データ行+2行までをループ処理
    For p = 3 To WorksheetFunction.CountA(shtList.Range(shtList.Cells(3,"F"), shtList.Cells(Rows.Count, "F").End(xlUp))) + 2
        'F列の値を取得(listシートの対象行・F列のセル)
        yearF = shtList.Cells(p, "F").Value
        Debug.Print "F:" & p & " , " & yearF

        If WorksheetFunction.CountIf(shtSummary.Range("7:7"), yearF) = 0 Then
            Dim rngAreaF As Range
            Dim rngAreaT As Range
            'コピー範囲始点(年間集計.E7セル)
            set rngAreaF = shtSummary.Cells(7, "E")
            'コピー範囲終点(年間集計.E列最終データセル)
            set rngAreaT = shtSummary.Cells(shtSummary.Cells(Rows.Count, "E").End(xlUp).Row, "E")

            'コピー範囲の取得(始点~終点)
            Dim rngCopy As Range
            Set rngCopy = shtSummary.Range(rngAreaF, rngAreaT)
            With rngCopy
                .Copy
                .Insert xlShiftToRight, copyorigin:=xlFormatFromRightOrBelow
                .PasteSpecial Paste:=xlPasteColumnWidths
                .PasteSpecial Paste:=xlPasteFormats
            End With

            shtSummary.Cells(7, "E").Value = yearF '?1つだけ空になる■

        End If
    Next p

参考になれば幸いです。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

+1

直接原因かどうか分かりませんが、
セルへアクセス(Range,Cells等)する際に、
Range("") や Cells(1 ,2) 等と親(Sheet)を省略すると、
自動的にActiveSheet上のセルが適用されます。

ご提示のコードを見るに、幾つか親が省略されてますので、
デバッグ時や、処理時にActiveSheetが変わってしまうと、
結果が変わってしまう、不安定なプログラムになります。

それを回避する為には幾つかのコツがあります。

  1. シートをWorkSheet型変数に格納する(Sheet.・・・でドットを打つと、候補が出るので楽になります)
  2. With Sheet で、頻出のシートを省略しつつ、.Range や .Cells とドットから書く
Private Function test()

    Dim ListSht As Worksheet
    Set ListSht = ThisWorkbook.Worksheets("list")

    Dim SumSht  As Worksheet
    Set SumSht = ThisWorkbook.Worksheets("年間集計")

    With ListSht

        Dim Row_S   As Long
        Dim Row_E   As Long
        Row_S = 3
        Row_E = fRange_EndRow(.Cells(Row_S, 6))
        If (Row_S <= Row_E) = False Then Exit Function

        Row_E = Row_E + 2

    End With

    With SumSht

        Dim Row_T   As Long
        For Row_T = Row_S To Row_E

            Dim Year As Integer
            Year = ListSht.Range("F" & Row_T).Value

            If Year = 0 Then

                '●デバッグ用
                Call MsgBox("年が正しくセットされていません", vbCritical + vbOKOnly)

            Else

                '項目行(西暦)
                Dim Row_Sum As Long
                Row_Sum = 7

                If WorksheetFunction.CountIf(.Range(Row_Sum & ":" & Row_Sum), Year) = 0 Then

                    'E列
                    Dim Col_Sum   As Long
                    Col_Sum = 5

                    Dim Row_End As Long
                    Row_End = fRange_EndRow(.Cells(Row_Sum, Col_Sum))

                    Dim CopyArea    As Range
                    Set CopyArea = .Range(.Cells(Row_Sum, Col_Sum), .Cells(Row_End, Col_Sum))

                    With CopyArea
                        .Copy
                        .Insert xlShiftToRight, CopyOrigin:=xlFormatFromRightOrBelow
                        .PasteSpecial Paste:=xlPasteColumnWidths
                        .PasteSpecial Paste:=xlPasteFormats
                    End With

                    .Cells(Row_Sum, Col_Sum).Value = Year '?1つだけ空になる■

                End If

            End If

        Next

    End With

End Function

Public Function fRange_EndRow(Cell As Range) As Long

    With Cell.Worksheet
        fRange_EndRow = .Cells(.Rows.Count, Cell.Column).End(xlUp).Row
    End With

End Function

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

check解決した方法

0

自己解決しました。事後報告です。
.PasteSpecial Paste:=xlPasteFormats
をコメントアウトしたところ2019表示できました。

原因・理由は不明です。

ありがとうございました。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

yearF=0となると書いてますが、ループのIf文を除いた処理だけを見た場合、正常に動作しており、yearFは2019になりました。
If文内でもyearFの更新はありませんから、yearFが0になっているのではなく、結果としてシート上0が入るということを言っているのではないかと推測します。
前述通り、ループ処理およびIf文は正しく動いていると思われますので、問題はWithから始まるコピー処理かと思われます。
決定的な原因はわからないのですが、

Cells(Rows.Count, 5).End(xlUp).Row

ここらへんが原因でしょうか。
ここのCellsは最初に選択したlistシートが対象になってしまいますので、想定外の範囲を指定している可能性があります。
こうしたら状況が変わるかもしれません。

Worksheets("年間集計").Cells(Rows.Count, 5).End(xlUp).Row

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/10/26 11:38 編集

    コメントありがとうございます。
    Worksheets("年間集計").Cells(Rows.Count, 5).End(xlUp).Row
    やってみましたが変わらずです。
    デバッグで見ると、
    F:3 , 2017
    F:4 , 2018
    F:5 , 0
    です。なぜ最後が、2019のはずなのに、0なのか謎です。

    キャンセル

  • 2017/10/26 12:02

    予想が外れましたね。申し訳ない。
    上記の、F:3 , 0とは、yearFの値でしょうか?
    まずはループ内のIF文をコメントアウト等するして、yearFが正しく設定されているかどうかの確認からしてみてください。

    キャンセル

  • 2017/10/26 14:37 編集

    いえいえとんでもない。
    F:5 , 0(訂正)とは、yearFの値です。

    行や列の挿入削除が他のマクロの動作でなされた後ではセル参照がずれることが有るという記事もありましたが、参照シートである「list」においては行や列の挿入も削除もしていません。

    デバッグで、マウスオーバーで値の確認ができます。 p=5ならyearF=2019のはずですが、なぜp=5だけyearFが0となるのか頭を抱えています。

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 89.21%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる