Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

5689 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

▼

【49303】一部更新しないマクロをつくりたい かつこ 07/5/30(水) 20:29

【49321】Re:一部更新しないマクロをつくりたい Jaka 07/5/31(木) 11:22

【49350】Re:一部更新しないマクロをつくりたい かつこ 07/5/31(木) 21:25

【49354】Re:一部更新しないマクロをつくりたい Jaka 07/6/1(金) 13:53

【49360】Re:一部更新しないマクロをつくりたい かつこ 07/6/1(金) 23:37

【49363】Re:一部更新しないマクロをつくりたい かつこ 07/6/2(土) 0:37

【49405】Re:一部更新しないマクロをつくりたい Jaka 07/6/4(月) 13:23

【49429】Re:一部更新しないマクロをつくりたい かつこ 07/6/4(月) 23:41

【49452】Re:一部更新しないマクロをつくりたい Jaka 07/6/5(火) 14:50

【49466】Re:一部更新しないマクロをつくりたい かつこ 07/6/5(火) 22:05


	【49303】一部更新しないマクロをつくりたい

かつこ - 07/5/30(水) 20:29 -


	引用なし

	パスワード

こんばんは。

BOOK1.xls　　　　(シート名データ）　　　　　　　　
4月　　　　5月　　　　6月　　　　
100　　　　200　　　　300　　　　

BOOK２.xls　　　　　　　　　　　　
4月　　　　5月　　　　6月　　　　
300　　　　400　　　　500　　　　

転記.xls（シート名は一覧）
　　　　4月　　　　5月　　　　6月
BOOK1　　　　100　　　　200　　　　300
BOOK2　　　　300　　　　400　　　　500

ひとつのフォルダにBOOK1やBOOK2のような形式のファイルが
多くあります。
それを転記.xlsに転記しています。

もしBOOK1の4月が100→150にかわったら
私の書いたコードでは
転記.xlsのBOOK1の4月は150になります。

が、今現在(5月）以前のデータに
関しては数字を固定させたいのです。
150と変更しても変更しないようなマクロに
仕上げたいのですが
どのような方法がありますでしょうか？

現在(5月）以降は・・たとえば
BOOK1の6月が300→350に変われば
転記.xlsの6月は350にしたいです。

よろしくおねがいいたします。

Sub kousin()
　　Dim thename As String
　　Dim thedir As String
　　Dim thebook As Workbook
　　Dim AROW As Integer
　　Dim myarray As Variant
　　Dim i As Integer
　　
　　Application.ScreenUpdating = False
　　thedir = "C:\documents and settings\kousin"
　　thename = Dir(thedir & "\*.xls")
　　
　　Do While thename <> ""
　　　 Set thebook = Workbooks.Open(thedir & "\" & thename)
　　　 AROW = ThisWorkbook.Worksheets("一覧").Range("A65536").End(xlUp).Row
　　　 ThisWorkbook.Worksheets("一覧").Cells(AROW + 1, 1).Value = _
　　　　　　　　　　Left$(thename, len8thename - 4)
　　　　　　　　　　
　　　 With thebook.Worksheets("データ")
　　　　　　myarray = Array(.Range("B2"), .Range("C2"), .Range("D2"))
　　　　　　　For i = 1 To 3
　　　　　　　　　ThisWorkbook.Worksheets("一覧").Cells(AROW + 1, 1 + i) _
　　　　　　　　　　　　　　 .Value = myarray(i)
　　　　　　　Next i
　　　 End With
　　　
　　　 thebook.Close savechanges:=False
　　　 thename = Dir()
　　 Loop
　　
　　 Application.ScreenUpdating = True
　　
End Sub


	【49321】Re:一部更新しないマクロをつくりたい

Jaka - 07/5/31(木) 11:22 -


	引用なし

	パスワード

▼かつこさん：
>もしBOOK1の4月が100→150にかわったら
>私の書いたコードでは
>転記.xlsのBOOK1の4月は150になります。

>が、今現在(5月）以前のデータに
>関しては数字を固定させたいのです。
>150と変更しても変更しないようなマクロに
>仕上げたいのですが

すみません。
この辺の意味合いがよく解りません。
BOOK2の４月は書き換えてますけど...。

単にＢＯＯＫ１、ＢＯＯＫ２のデータを転記.xls（シート名は一覧）に追加していくだけじゃないんですか？
のつもりでいじってみたけれど、意味合いがわかってないので、外れていると思います。

Sub kousin()
　　Dim thename As String
　　Dim thedir As String
　　Dim thebook As Workbook
　　Dim AROW As Long　　'シートの行に対しては、Longが安全。
　　Dim myarray As Variant
　　Dim i As Integer

　　Dim EROW As Long
　
　　Application.ScreenUpdating = False
　　thedir = "C:\documents and settings\kousin"
　　thename = Dir(thedir & "\*.xls")

　　Do While thename <> ""
　　　 Set thebook = Workbooks.Open(thedir & "\" & thename)
　　　 AROW = ThisWorkbook.Worksheets("一覧").Range("A65536").End(xlUp).Row
　　　 ThisWorkbook.Worksheets("一覧").Cells(AROW + 1, 1).Value = _
　　　　　　　　　　Left$(thename, Len(thename) - 4)

　　　 With thebook.Worksheets("データ")
　　　　　　For i = 1 To 3
　　　　　　　　If Val(.Cells(1, i).Value) > 4 Then
　　　　　　　　　 ThisWorkbook.Worksheets("一覧").Cells(AROW + 1, 1 + i).Value = .Cells(1, i).Value
　　　　　　　　End If
　　　　　　Next i
　　　 End With

　　　 thebook.Close savechanges:=False
　　　 thename = Dir()
　　 Loop

　　 Application.ScreenUpdating = True
End Sub


	【49350】Re:一部更新しないマクロをつくりたい

かつこ - 07/5/31(木) 21:25 -


	引用なし

	パスワード

▼Jaka さん：お返事ありがとうございます。言葉足らずで申し訳ありません。 >>もしBOOK1の4月が100→150にかわったら >>私の書いたコードでは >>転記.xlsのBOOK1の4月は150になります。 > >この辺の意味合いがよく解りません。 >BOOK2の４月は書き換えてますけど...。私のコードでは書き換わってしまうのです・・書き換えたくないのです。追加説明させていただきます。元のデータは・・ 4月　5月　6月 100　200　300 これはA1：C2までに入っています。この形式のファイルが多くあります。これを転記.xlsに転記します。 4月　5月　6月 100　200　300 となり、この下にほかのファイルのデータが転記されます。ここまでは最初に書かせていただいたコードで動きました。現在の月(今は5月)より前の月までの転記.xls の数字は変更したくないということで Jakaさんに教えていただいたコードで行ってみると 4月　5月　6月　　 200　300 と4月は空白になってしまいました。なので、withの中を一旦全部を転記させ、5月以降のデータを上書きする形に変更してみました。 With thebook.Worksheets("データ") 　　　　　　For i = 1 To 3 　　　　　　　　ThisWorkbook.Worksheets("一覧").Cells(AROW + 1, 1 + i).Value = .Cells(1, i).Value　　　　　　　　　If Val(.Cells(1, i).Value) > 4 Then 　　　　　　　　　 ThisWorkbook.Worksheets("一覧").Cells(AROW + 1, 1 + i).Value = .Cells(1, i).Value 　　　　　　　　End If 　　　　　　Next i 　　　 End With この結果は 4月　5月　6月 100　200　300 になります。ここでこのコードのまま、6月のデータを300→350にしてみると 4月　5月　6月 100　200　350 になりました。そして上のコードのままで 4月のデータを100→150にしてみると 4月　5月　6月 150　200　350 と書き換えられてしまいました。一旦転記するというコードを書いてしまっているのが原因だとは思うのですが・・ 4月　5月　6月 100　200　350 にする方法を探しています。もし6月になったら今度は5月分も数字を固定させたい。 4月　5月 100　200 は元のデータを変更しても変えたくないのです。よろしくおねがいいたします。


	【49354】Re:一部更新しないマクロをつくりたい

Jaka - 07/6/1(金) 13:53 -


	引用なし

	パスワード

国語力が貧相なJakaです。
やっぱり質問の意味がよく解りませんでした。

提示されたシートレイアウト通りに？BOOK1.xls、BOOK2.xlsを作り、
BOOK1、2のデータがあるであろうシート名を「データ」とし、
実行ファイルのシートの１つを「一覧」にして、最初に提示されたコードを
走らせて見ましたが、動きませんでした。
質問の中では動いているそうですが...？？

で、データレイアウトを下記のように変え、

BOOK1.xls　　　　(シート名データ）
　　B　　　　 C　　　　　D
1　4月　　　　5月　　　　6月
2　100　　　　200　　　　300

BOOK２.xls
　　B　　　　 C　　　　　D
1　4月　　　　5月　　　　6月
2　300　　　　400　　　　500

コードを下記に変えて動かしてみました。、

Sub kousin()
　　Dim thename As String
　　Dim thedir As String
　　Dim thebook As Workbook
　　Dim AROW As Integer
　　Dim myarray As Variant
　　Dim i As Integer

　　Application.ScreenUpdating = False
　　
　　thedir = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\dddd"
　　
　　thename = Dir(thedir & "\*.xls")
　　Do While thename <> ""
　　　 If thename <> ThisWorkbook.Name Then
　　　　　Set thebook = Workbooks.Open(thedir & "\" & thename)
　　　　　AROW = ThisWorkbook.Worksheets("一覧").Range("A65536").End(xlUp).Row
　　　　　ThisWorkbook.Worksheets("一覧").Cells(AROW + 1, 1).Value = _
　　　　　　　　　　　 Left$(thename, Len(thename) - 4)

　　　　　With thebook.Worksheets("データ")
　　　　　　　 myarray = Array(.Range("B2"), .Range("C2"), .Range("D2"))
　　　　　　　 For i = 0 To 2
　　　　　　　　　 ThisWorkbook.Worksheets("一覧").Cells(AROW + 1, 2 + i) _
　　　　　　　　　　　　　　 .Value = myarray(i)
　　　　　　　 Next i
　　　　　End With

　　　　　thebook.Close savechanges:=False
　　　 End If
　　　 thename = Dir()
　　 Loop
　　 Application.ScreenUpdating = True
End Sub

実行１回目、一覧シートの結果

　　 A　　 B　　 C　　 D
1　　　　 4月　 5月　 6月
2　Book1　100　 200　 300
3　Book2　300　 400　 500

BOOK1の内容を↓この様に変えて

　　B　　　　 C　　　　　D
1　4月　　　　5月　　　　6月
2　100　　　　200　　　　300

実行２回目、一覧シートの結果

　　 A　　 B　　 C　　 D
1　　　　 4月　 5月　 6月
2　Book1　100　 200　 300
3　Book2　300　 400　 500
4　Book1　150　 200　 300
5　Book2　300　 400　 500

このようになります。
>書き換えられてしまいました
とはなりません。

また、最初に提示してあったコードのこれ、エラーになりませんでしたか？

　　　　　　myarray = Array(.Range("B2"), .Range("C2"), .Range("D2"))
　　　　　　　For i = 1 To 3

i = 0 to 2
では。

それと、
>4月　5月　6月
>100　200　350
と、書くと読んだ人は、Ａ、Ｂ、Ｃ列と判断します。
なのに
>Array(.Range("B2"), .Range("C2"), .Range("D2"))
Ｂ、Ｃ、Ｄ列なんですよね？

もっとシートレイアウトは正しく、誰が見ても解るように
コードは実際に、動いたものを載せてください。
質問内容を国語力が貧相な私にもわかるぐらいにしてください。

国語力が貧相ですみません。


	【49360】Re:一部更新しないマクロをつくりたい

かつこ - 07/6/1(金) 23:37 -


	引用なし

	パスワード

▼Jaka さん：
ありがとうございます。

>国語力が貧相なJakaです。
>やっぱり質問の意味がよく解りませんでした。
うまく伝えられない私が、申し訳ありませんm(_ _)m

>
>提示されたシートレイアウト通りに？BOOK1.xls、BOOK2.xlsを作り、
>BOOK1、2のデータがあるであろうシート名を「データ」とし、
>実行ファイルのシートの１つを「一覧」にして、最初に提示されたコードを
>走らせて見ましたが、動きませんでした。
>質問の中では動いているそうですが...？？
>
>で、データレイアウトを下記のように変え、
>
>BOOK1.xls　　　　(シート名データ）
>　　B　　　　 C　　　　　D
>1　4月　　　　5月　　　　6月
>2　100　　　　200　　　　300
>
>BOOK２.xls
>　　B　　　　 C　　　　　D
>1　4月　　　　5月　　　　6月
>2　300　　　　400　　　　500
>
>コードを下記に変えて動かしてみました。、
>
>Sub kousin()
>　　Dim thename As String
>　　Dim thedir As String
>　　Dim thebook As Workbook
>　　Dim AROW As Integer
>　　Dim myarray As Variant
>　　Dim i As Integer
>
>　　Application.ScreenUpdating = False
>　　
>　　thedir = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\dddd"
>　　
>　　thename = Dir(thedir & "\*.xls")
>　　Do While thename <> ""
>　　　 If thename <> ThisWorkbook.Name Then
>　　　　　Set thebook = Workbooks.Open(thedir & "\" & thename)
>　　　　　AROW = ThisWorkbook.Worksheets("一覧").Range("A65536").End(xlUp).Row
>　　　　　ThisWorkbook.Worksheets("一覧").Cells(AROW + 1, 1).Value = _
>　　　　　　　　　　　 Left$(thename, Len(thename) - 4)
>
>　　　　　With thebook.Worksheets("データ")
>　　　　　　　 myarray = Array(.Range("B2"), .Range("C2"), .Range("D2"))
>　　　　　　　 For i = 0 To 2
>　　　　　　　　　 ThisWorkbook.Worksheets("一覧").Cells(AROW + 1, 2 + i) _
>　　　　　　　　　　　　　　 .Value = myarray(i)
>　　　　　　　 Next i
>　　　　　End With
>
>　　　　　thebook.Close savechanges:=False
>　　　 End If
>　　　 thename = Dir()
>　　 Loop
>　　 Application.ScreenUpdating = True
>End Sub
>
>
>実行１回目、一覧シートの結果
>
>　　 A　　 B　　 C　　 D
>1　　　　 4月　 5月　 6月
>2　Book1　100　 200　 300
>3　Book2　300　 400　 500
>
>
>BOOK1の内容を↓この様に変えて
>
>　　B　　　　 C　　　　　D
>1　4月　　　　5月　　　　6月
>2　100　　　　200　　　　300
>
>
>実行２回目、一覧シートの結果
>
>　　 A　　 B　　 C　　 D
>1　　　　 4月　 5月　 6月
>2　Book1　100　 200　 300
>3　Book2　300　 400　 500
>4　Book1　150　 200　 300
>5　Book2　300　 400　 500
>
>このようになります。
>>書き換えられてしまいました
>とはなりません。

thisworkbook.worksheets("一覧").range("A2:D65536").clearcontents
記入漏れがありました。

>
>また、最初に提示してあったコードのこれ、エラーになりませんでしたか？
>
>　　　　　　myarray = Array(.Range("B2"), .Range("C2"), .Range("D2"))
>　　　　　　　For i = 1 To 3
>
>i = 0 to 2
>では。

option explicit
option base 1
を設定しているので1始まりになっています。
しかしセルが連なっているのでわざわざarrayを使わず
Jakaさんのコードで書かれているcells(1,i)のように
するほうがわかりやすかったので変えます。

>
>それと、
>>4月　5月　6月
>>100　200　350
>と、書くと読んだ人は、Ａ、Ｂ、Ｃ列と判断します。
>なのに
>>Array(.Range("B2"), .Range("C2"), .Range("D2"))
>Ｂ、Ｃ、Ｄ列なんですよね？
>
>もっとシートレイアウトは正しく、誰が見ても解るように
>コードは実際に、動いたものを載せてください。
>質問内容を国語力が貧相な私にもわかるぐらいにしてください。
>

記入漏れ、書き間違いがあり
混乱させてしまいました。
申し訳ございません。
B、C、D列で4月5月6月です。

ここからも長くなりそうなので
続きを次の投稿で書きたいと思います。


	【49363】Re:一部更新しないマクロをつくりたい

かつこ - 07/6/2(土) 0:37 -


	引用なし

	パスワード

続きです。
動きが確認できたコードはこれになります。

Sub kousin()
　　Dim thename As String
　　Dim thedir As String
　　Dim thebook As Workbook
　　Dim AROW As Long
　　Dim i As Integer
　　
　　Application.ScreenUpdating = False
　　thedir = "C:\documents and settings\kousin"
　　thename = Dir(thedir & "\*.xls")
　　
　　thisworkbook.worksheets("一覧").range("A2:D65536").clearcontents　　

　　Do While thename <> ""
　　　 Set thebook = Workbooks.Open(thedir & "\" & thename)
　　　 AROW = ThisWorkbook.Worksheets("一覧").Range("A65536").End(xlUp).Row
　　　 ThisWorkbook.Worksheets("一覧").Cells(AROW + 1, 1).Value = _
　　　　　　　　　　Left$(thename, len(thename) - 4)
　　　　　　　　　　
　　　 With thebook.Worksheets("データ")
　　　　　　　For i = 1 To 3
　　　　　　　　　ThisWorkbook.Worksheets("一覧").Cells(AROW + 1, 1 + i) _
　　　　　　　　　　　　　　 .Value = .cells(2,i).value
　　　　　　　Next i
　　　 End With
　　　
　　　 thebook.Close savechanges:=False
　　　 thename = Dir()
　　 Loop
　　
　　 Application.ScreenUpdating = True
End Sub

BOOK1.xls
B　　C　　D
4月　5月　6月
100　200　300

BOOK2.xls
B　　C　　D
4月　5月　6月
300　400　500

もしBOOK1.xlsの4月を100→150に変えると
このコードでは
　　　　4月　5月　6月
BOOK1　150　200　300
BOOK2　300　400　500
という結果になります。

もしBOOK1.xlsの6月を300→350に変えると
このコードでは
　　　　4月　5月　6月
BOOK1　100　200　350
BOOK2　300　400　500
という結果になります。

現在5月15日だとすると5月はまだ終わっていないため確定できないが
4月（前月）までの転記先のデータ分は確定させたい。

　　　　4月　
BOOK1　100　
BOOK2　300　

上記の部分を確定させたい。

　　　　4月　5月　6月
BOOK1　100　200　350
BOOK2　300　400　500

という結果が出た後

BOOK1.xlsが
B　　C　　D
4月　5月　6月
100　200　300
↓
B　　C　　D
4月　5月　6月
150　200　300
になっても
転記.xlsのほうには反映させたくない。
転記.xlsの4月分のデータは保護したい。

　　　　4月　5月　6月
BOOK1　100　200　350
BOOK2　300　400　500
という結果のままにしたいです。

もし5月分に変更があった場合
B　　C　　D
4月　5月　6月
100　200　300
↓
B　　C　　D
4月　5月　6月
100　250　300
5月分はまだ未確定なので
変更を受け付け、

　　　　4月　5月　6月
BOOK1　100　250　350
BOOK2　300　400　500
という結果になるようにしたいです。

do while～の直前に
if val(thisworkbook.worksheet("一覧").cells(1,2).value)_
　　　　　　　　　　 =month(date)-1 then
　 cells(cells(2,2),cells(AROW+1,2).locked=true
end if
を付け加えて転記．xlsのセルを保護したらいいのかなと思ったのですが・・
違うようでした。

ん～ん、伝わりましたでしょうか・・・

よろしくおねがいします。


	【49405】Re:一部更新しないマクロをつくりたい

Jaka - 07/6/4(月) 13:23 -


	引用なし

	パスワード

データがこうなっているのは解りました。
>BOOK1.xls
>B　　C　　D
>4月　5月　6月
>100　200　300

>BOOK2.xls
>B　　C　　D
>4月　5月　6月
>300　400　500

問題は、
>もしBOOK1.xlsの4月を100→150に変えると
>もしBOOK1.xlsの6月を300→350に変えると
なんですが、
一覧シートに追加していくんじゃないんですか？
なんで、変えるとか変わるという表現がでてくるのでしょうか？？？
それに、同一フォルダに同じファイル名のファイルは置けないはずですが...。
マクロを走らせるタイミングもよく解りません。
なんで、わざわざデータを書き換えて、２回もマクロを走らせる必要があるのでしょうか？

また、実行するごとに
thisworkbook.worksheets("一覧").range("A2:D65536").clearcontents
で、クリアしてから処理に入ってますが.........。
これだと、書き換えられるとかでなく、全て開いたブックのデータになりませんか？
４月分を書き込まなくても消されているから何も残りませんけど。

>ん～ん、伝わりましたでしょうか・・・
すみません。残念ながら、私の国語力ではよく解りませんでした。
質問内容を簡略化して書こうとかしてませんか？


	【49429】Re:一部更新しないマクロをつくりたい

かつこ - 07/6/4(月) 23:41 -


	引用なし

	パスワード

お返事ありがとうございます。
あまりに抽象的な言い方でわかりにくいですよね・・・
申し訳ありません。

今回はエクセルファイルの名前やその他の流れについても
具体的に省かず書いてみます。

福岡支店.xls
B　　 C　　D　　E
4月　5月　6月　7月
100　200　300　0

大阪支店.xls
B　　 C　　D　　E
4月　5月　6月　7月
300　400　500　0

東京支店.xls
B　　 C　　D　　E
4月　5月　6月　7月
400　500　600　0

このような形式の売上ファイルがkousinというフォルダに入っています。

これらのファイルは各店舗管理で業務終了後にxlsデータとして
私のところに届き、私がフォルダに収納しています。

そのフォルダ内ファイルのデータをひとつのxlsファイルにまとめています。
それが

売上表.xls
A　　 B　　 C　　D　　E
　　　4月　5月　6月　7月
福岡　100　200　300　0
大阪　300　400　500　0
東京　400　500　600　0

です。

6月4日現在のデータは上記になっています。
6月4日営業終了時点で売上数が
大阪支店の6月の500→550に上がったとすると
大阪支店.xlsのデータは下記のようになります。

大阪支店.xls
B　　 C　　D　　E
4月　5月　6月　7月
300　400　550　0

大阪支店からデータが送られてくると
フォルダに入っている分（6月3日のデータ）に上書きをし、新しいデータの
大阪支店.xlsを置きます。

そこで売上表.xlsを更新すると

売上表.xls
A　　 B　　 C　　D　　E
　　　4月　5月　6月　7月
福岡　100　200　300　0
大阪　300　400　550　0
東京　400　500　600　0

になります。

もし大阪支店の担当者が
6月4日の売上50を間違えて
6月ではなく4月に足してしまった場合

大阪支店.xls
B　　 C　　D　　E
4月　5月　6月　7月
350　400　500　0

となり、
私にはこのデータが届いてしまいます。

しかし実際には4月分に売上が上がるはずがない。

なので、売上表.xlsは

売上表.xls
A　　 B　　 C　　D　　E
　　　4月　5月　6月　7月
福岡　100　200　300　0
大阪　300　400　500　0
東京　400　500　600　0

という結果にしたい。
4月の間違った入力の影響は受けていない、
過去に確定してしまった売上の変更は受け付けない、
結果を出すマクロを考えています。

伝わりましたでしょうか。。。

追記。
今回7月の欄も表示させました。
1年分（4月～翌年3月）まで書いてあります。
7月分からは売上はないので0が入っています。


	【49452】Re:一部更新しないマクロをつくりたい

Jaka - 07/6/5(火) 14:50 -


	引用なし

	パスワード

▼かつこさん：
>追記。
>今回7月の欄も表示させました。
>1年分（4月～翌年3月）まで書いてあります。
>7月分からは売上はないので0が入っています。
こういうのがダメな質問の仕方なんです。
回答する方は、提示されたデータ＆シートレイアウトでコードを書きます。
質問者は、提示されたコードを自分で改良して使おうと思っているのか解りませんが、
それだけのスキルが無く、後で
「実は○○になっていて、××なんです。教えてください。」
ってなことがやたらと多いんです。

更に途中でこうした方が良いかもなんて思うもんですから、何々を追加してください。
ってな事も起こることも多いです。
こうなるとあれですね....。

提示されたデータ分でしか考えてませんです。

Sub kousin()
　　Dim thename As String
　　Dim thedir As String
　　Dim thebook As Workbook
　　Dim AROW As Long
　　Dim i As Integer
　　Dim RRW As Variant, DNam As String
　　Const 確定月 As Integer = 5　　　　　'←確定は、１～５月まで

　　Application.ScreenUpdating = False
　　'thedir = "C:\documents and settings\kousin"
　　thedir = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\kousin"
　　thename = Dir(thedir & "\*.xls")

　　'ThisWorkbook.Worksheets("一覧").Range("A2:D65536").ClearContents

　　Do While thename <> ""
　　　 If ThisWorkbook.Name <> thename Then
　　　　　Set thebook = Workbooks.Open(thedir & "\" & thename)
　　　　　AROW = ThisWorkbook.Worksheets("一覧").Range("A65536").End(xlUp).Row + 1
　　　　　DNam = Left$(thename, Len(thename) - 4)

　　　　　With thebook.Worksheets("データ")
　　　　　　　i = 2
　　　　　　　Do
　　　　　　　　 If Val(.Cells(1, i).Value) > 確定月 Then
　　　　　　　　　　With ThisWorkbook.Worksheets("一覧")
　　　　　　　　　　　　RRW = Application.Match(DNam, .Columns(1), 0)
　　　　　　　　　　　　If Not IsError(RRW) Then
　　　　　　　　　　　　　 AROW = RRW
　　　　　　　　　　　　Else
　　　　　　　　　　　　　 .Cells(AROW, 1).Value = DNam
　　　　　　　　　　　　End If
　　　　　　　　　　　　.Cells(AROW, i).Value = thebook.Worksheets("データ").Cells(2, i).Value
　　　　　　　　　　End With
　　　　　　　　 End If
　　　　　　　　 i = i + 1
　　　　　　　Loop Until .Cells(1, i).Value = Empty
　　　　　End With

　　　　　thebook.Close savechanges:=False
　　　 End If
　　　 thename = Dir()
　　 Loop

　　 Application.ScreenUpdating = True
End Sub


	【49466】Re:一部更新しないマクロをつくりたい

かつこ - 07/6/5(火) 22:05 -


	引用なし

	パスワード

いろいろお手数おかけしました。
ご教授頂き、ありがとうございます。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

5689 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free