VBA 33行目までしか動かない理由

Question

以下のコードなのですが、
契約情報シートの33行目までの情報は、作成情報シートへ抽出されるのですが、
34行目以下の情報は抽出されません。
使用するデータから考えて300行くらいまでは使えるようにしたいのですがどこを変更したらいいのかわかりません。
お力お貸しください。

  If ActiveSheet.FilterMode Then
  '絞り込まれていたら

 ActiveSheet.ShowAllData

 End If

    Dim twb, cwb As Workbook
    Dim curPath, Sakusei As String
    Dim ws1, ws2 As Worksheet
    Dim StartRow, EndRow, tmpRow As Integer
    Dim wb As Workbook, flag As Boolean

    Set twb = ThisWorkbook
    curPath = twb.Path

    'ブックが既に開いているかどうかチェック
    For Each wb In Workbooks
        If wb.Name = "書類作成.xlsm" Then
            flag = True
            Exit For
        End If
    Next wb
    '既に開いている場合
    If flag = True Then
        'オブジェクトにセット
        Set cwb = Workbooks("書類作成.xlsm")
        cwb.Activate
    Else
        '新規で開いてオブジェクトにセット
        Workbooks.Open Filename:=curPath & "書類作成.xlsm"
        Set cwb = ActiveWorkbook
    End If

    'シート名を変えている場合は適宜変更
    Set ws1 = twb.Worksheets("契約情報")
    Set ws2 = cwb.Worksheets("作成情報")


    ws2.Range("2:11").ClearContents

    '作成シートに指定されている抽出条件
    Sakusei = ws2.Cells(1, "A")

    StartRow = 2
    EndRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row
    tmpRow = 2

    For i = StartRow To EndRow
        If (ws1.Cells(i, "A") = Sakusei) Then
            ws2.Cells(tmpRow, "A") = Sakusei
            '範囲コピー
            ws2.Range(ws2.Cells(tmpRow, "C"), ws2.Cells(tmpRow, "K")).Value = ws1.Range(ws1.Cells(i, "C"), ws1.Cells(i, "K")).Value
            tmpRow = tmpRow + 1
        End If
    Next

End Sub

コード

Comments

[sinzou]

EndRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row
なので　C列の最終行は？
(ws1.Cells(i, "A") = Sakusei
A列の文字列とSakuseiとイコールでないから？　空白、－と-　　とかないですか？

[Mkasai]

C列の最終行は301行です。
後は何を確認したらよろしいのでしょうか。

[sinzou]

再度確認ですが１物件のみ転記ですか？
関連物件 -02 や -03　も含めるのですか？

[Mkasai]

動きました。
Cセルに何もデータが入っていないと他のセルに情報が入っていても動かないようです。
この部分は改善できるのでしょうか。

[sinzou]

EndRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row
はC列の最終行なので
EndRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
A列の最終行でおこなえば？

[yureighost]

ws1.Cells(Rows.Count, "C").End(xlUp).Rowの動作をExcelの操作で説明すると、
「C列の最終行からCtrl+↑を実行した」という物でC列の最後のデータが入っている行に移動します。
そのため処理を実行したい行までデータが入っている列を対象としないといけません。

抽出検索条件が入っているA列とかは空白のデータが入っていない行とかあるのでしょうか。

[Mkasai]

A列としたら問題なく動きました。
ありがとうございました。

Answer 1

EndRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row

が処理最終行を指してそうです。

Rows.Countの部分が開いているシート内容によって不定になるので
⇢ 不定というのは誤りでした。失礼しました。常に最終行になるので、65535 or 1048576になります。

EndRow = 300

の様に固定値にしてしまうか、「契約情報」シートのC列の最後、という意図で書かれているなら

EndRow = ws1.Cells(65536, "C").End(xlUp).Row

のように適当に大きな数値からxlUpを試してみるのはどうでしょうか。

Comments

[hatena19]

Rows.Count はシートに関係なく一定ですよ。
Excelのバージョンに依存しますが。
Office2003以前は65536、Office2007以降は1048576。

[Mkasai]

大きい数値で試してみたのですが、変わりません。
他が間違っているのでしょうか。

[Mkasai]

動きました。
Cセルに何もデータが入っていないと他のセルに情報が入っていても動かないようです。
この部分は改善できるのでしょうか。

[Eggpan]

＞hatena19さん
勘違いしていたようです。回答修正します。失礼しました。

＞Mkasaiさん
Cセルを上にたどっていっているコードなので、そのようになります。

[mattuwan]

>Cセルに何もデータが入っていないと他のセルに情報が入っていても動かないようです。
>この部分は改善できるのでしょうか。
C列で最終データのセルを探しているから、C列の最終行番号が返ってきてるので、
A列とかB列とか、「最終のデータ」が入っている列で探せばいいのでは？

Answer 2

sinzouさんよりA列の最終行で行うというアドバイスいただきまして、そのように変更しました。

EndRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row
を
EndRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
としました。
C列にこだわらなければいけない理由は特にないので、このように変更しました。

Answer 3

Option Explicit

Sub test()
    '絞り込まれていたら
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

    Dim curPath As String, Sakusei As String
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim StartRow As Integer, EndRow As Integer, tmpRow As Integer
    Dim wb As Workbook, flag As Boolean

    curPath = ThisWorkbook.Path

    'ブックが既に開いているかどうかチェック
    For Each wb In Workbooks
        If wb.Name = "書類作成.xlsm" Then Exit For
    Next
    'ループを最後まで回ったらwbはNothingになるので、無かったと判定
    If wb Is Nothing Then
        Set wb = Workbooks.Open(Filename:=curPath & "\書類作成.xlsm")
    End If

    'シート名を変えている場合は適宜変更
    Set ws1 = ThisWorkbook.Worksheets("契約情報")
    Set ws2 = wb.Worksheets("作成情報")


    ws2.Range("2:11").ClearContents

    '作成シートに指定されている抽出条件
    Sakusei = ws2.Cells(1, "A").Value

    StartRow = 2
    EndRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    tmpRow = 2

    For i = StartRow To EndRow
        If ws1.Cells(i, "A").Value = Sakusei Then
            ws2.Cells(tmpRow, "A").Value = Sakusei
            '範囲コピー
            ws2.Range(ws2.Cells(tmpRow, "C"), ws2.Cells(tmpRow, "K")).Value = ws1.Range(ws1.Cells(i, "C"), ws1.Cells(i, "K")).Value
            tmpRow = tmpRow + 1
        End If
    Next
End Sub

多分こんな感じだと思いますが、
動かしてみてないのでバグがあるかもです。

プロパティ、メソッドの探り方 マクロ記録とＦ１のHelpを使う
記事が古いけど、参考になれば。。。
上手く行かない時はステップ実行をしながら、ローカルウィンドウやウォッチ式、イミディエイトウィンドウ等で変数の中身が意図通りになっているか確認してみてください。
（解らない用語はまずは検索して調べてみてください。）

あと、オートフィルターを使えばループを自分で書かなくていいけど、
それは、とりあえずおいておいて、自分でVBAを組み立てる練習ということですかね？
もひとつ、操作するのは結局セル範囲（Rangeオブジェクト）なので、
操作対象のセル範囲を変数を用意して保持していった方が組み立て方も、
後で読む方も簡単になると思いました。