エクセルVBAで、ある条件の時

質問

お世話になります。
エクセルVBAで次のようなことをしたいのですが方法を教えてください。

formフォルダにあるすべてのファイルについて、A1セルが「0」でないとき、
A4:B7及びA9:B12の中で日付が入っている行の日付と内容を、ActiveWorksheetのB列、C列にレコードとして取り出したいのです。
（A列はナンバリングになります）

--------formフォルダの中にあるブック---------
　　A　　B
1　23
2
3　日付　内容　　　'この行は固定です
4　5/13　あああ
5　5/17　いいい
6
7
8　日付　内容　　　'この行は固定です
9　5/16　ううう
10　5/12　えええ
11
12　5/10　おおお

---ThisWorkbook（前に助けていただいたコードです）---
Sub data_torikomi2()

　　Dim wb As Workbook
　　Dim Fn As String
　　Dim myPath As String
　　Dim dbBkSh As Worksheet
　　Dim i As Long

　　For Each wb In Workbooks

　　　　If wb.Name <> ThisWorkbook.Name And _
　　　　InStr(1, wb.FullName, "form\", 1) > 0 Then 'formを検索
　　　　　　wb.Close '閉じる
　　　　End If
　　Next wb

　　myPath = ThisWorkbook.Path & "\"
　　Set dbBkSh = ThisWorkbook.Worksheets("一覧表")

　　　　　　　　　Range("4:1000").Clear '全データ削除

　　Fn = Dir(myPath & "form\*.xls")
　　i = 1
　　'画面のちらつきを抑える
　　Application.ScreenUpdating = False
　　Do Until Fn = ""
　　　　If Fn <> ThisWorkbook.Name Then
　　　　　　With Workbooks.Open(myPath & "form\" & Fn, , True)

　　　　　　　　dbBkSh.Range("A3").Offset(i, 0).Value = i

　　　　【★たぶんこの部分に入るものです★】

　　　　　　　　.Close False
　　　　　　　　i = i + 1
　　　　　End With
　　　　End If
　　　　Fn = Dir()
　　Loop
　　Application.ScreenUpdating = True
　　Set dbBkSh = Nothing

End Sub

ご教示よろしくお願いします。

回答No.2

Wendy02 · ベストアンサー

こんにちは。

最初から、書き込みが遅くなっているのに、その上に失敗して、ご迷惑掛けてしまい、すみません。

こちらの問題から先にします。
>また、行の数だけ「移動またはコピーしようとしている数式またはシートには
>移動またはコピー先のワークシートに既にある名前'※※'が含まれています。
>この名前を使用しますか？」

その場合は、値コピーのほうがよいですね。もし、書式情報もほしい場合は、別々のコピーをしなくてはなりません。当面、値コピーだけにしておきます。

>　　　.Cells(c.Row, 1).Resize(, 2).Copy _
>　　　　　　　　　 dbBkSh.Range("B3").Offset(i, 0)
　　　　　　　　　　↓

dbBkSh.Range("B3").Offset(i, 0).Resize(0, 2 ).Value = .Cells(c.Row, 1).Resize(, 2).Value

というスタイルになりますね。ちょっと試してみていただけますか？
前から、名前定義登録、独特のトラブルがあるのは知っていましたが、今回のトラブルの件は、想定外というところです。
---------------------------------------------------

>最後の日付と内容の1行分ずつしかデータベースに入っていきません。

　↓　この位置が違っていました。
i = i + 1

ループの中でなくてはいけませんでした。

　With Workbooks.Open(myPath & "form\" & Fn, , True)
　　'----------------------------
Set dbBksh = Worksheets("Sheet2")
　　With .ActiveSheet　　'
　　　　If .Range("A1").Value <> 0 Then
　　　　　　For Each c In .Range("A3:A9")
　　　　　　　　If IsDate(c.Value) Then
　　　　　　　　　　'A:B の該当する2列
　　　　　　　　 dbBksh.Range("A3").Offset(i, 0).Value = i
　　　　　　　　dbBksh.Range("B3").Offset(i, 0).Resize(, 2).Value = .Cells(c.Row, 1).Resize(, 2).Value
　　　　　　　　i = i + 1　　'この位置ですね。※
　　　　　　　　End If
　　　　　　Next c
　　　　End If
　　End With
'----------------------------

ちょっと、これで様子を見ていただけますか。

お礼

ご回答どうもありがとうございました。
おかげさまですべて思い通りのことができるようになりました。m(_ _)m

あと、ひとつだけお聞きしたいのですが、このデータは、多く見積もっても
300件くらいのデータなので、再読込するときには1000行分ほど削除して
更新すればいいと思い、次のようにしてみたのですが、

　　　Range("4:1000").Clear '全データ削除

もし1001行目以下になにか入っていたら、それは残ってしまうことになります。

4行目以降の内容をとにかく全部削除するにはどう記述すればよいのですか。
お礼の欄で質問してしまって申し訳ありません。

回答No.3

Wendy02

こんにちは。

>4行目以降の内容をとにかく全部削除するにはどう記述すればよいのですか。

Set dbBkSh = ThisWorkbook.Worksheets("一覧表")
With dbBkSh.UsedRange
　　If .Cells(.Cells.Count).Row > 3 Then
　　　.Range("A4", .Cells(.Cells.Count)).Clear
　　End If
End With

こんなコードはどうでしょう。二度マクロをRunしても、これなら問題ありません。また、UsedRangeは、必ずしも、A1 から始まるということにはなりません。.Cells(.Cells.Count) は、最後のセルを選択しています。

それと、同じだと思っていましたが、SpecialCells(xlCellTypeLastCell)　は、いくら、Clear(書式と値を削除）しても、それでも、消したはずの最後のセルを示しています。こちらは使えませんね。

お礼

UsedRangeプロパティというのがあるんですね。
何もかもが驚きの連続です。

Cells(.Cells.Count) にも感動しました。

勉強しなければならないことは山ほどありますが、今回おかげさまで、
知識不足でありながらもVBAの方はなんとか間に合いました。

本当にどうもありがとうございました。m(_ _)m

回答No.1

Wendy02

こんばんは。

質問は読んでいたのですが、すっかりレスを忘れていました。

>A4:B7及びA9:B12の中で日付が入っている行の日付と内容を、
とはなっていたけれども、実害がなさそうなので、「.Range("A4:A9")」とつなげてしまいました。一応、日付認識のテスト試験はしています。

>【★たぶんこの部分に入るものです★】

たぶん、線の中を入れ替えてあげれば、問題はないと思います。

　　With Workbooks.Open(myPath & "form\" & Fn, , True)
　　'----------------------------
　　With .ActiveSheet　　'
　　　　If .Range("A1").Value <> 0 Then
　　　　　　For Each c In .Range("A4:A9")
　　　　　　　　If IsDate(c.Value) Then
　　　　　　　　　　'A:B の該当する2列
　　　　　 　　　dbBkSh.Range("A3").Offset(i, 0).Value = i
　　　　　　　　　　.Cells(c.Row, 1).Resize(, 2).Copy _
　　　　　　　　　 dbBkSh.Range("B3").Offset(i, 0)
　　　　　　　　End If
　　　　　　Next c
　　　　End If
　　End With
　 '----------------------------

　　　　　　　　　.Close False
　　　　　　　　i = i + 1

お礼

いつもお世話になっておりますm(_ _)m。
ご回答ありがとうございました。
なるほど、Rangeをつなげて認識でチェックするのですね。

コードを試してみたところ、formフォルダにあるブックの日付と内容のうち、
最後の日付と内容の1行分ずつしかデータベースに入っていきません。

また、行の数だけ「移動またはコピーしようとしている数式またはシートには
移動またはコピー先のワークシートに既にある名前'※※'が含まれています。
この名前を使用しますか？」

というメッセージが出て、全部クリックしないと先に進みません。
これを表示させないようにできますでしょうか。

調べてもよくわかりません。ご教示よろしくお願いいたします。