Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8626 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【32172】ファイル名を取得して,ある列に代入するには にしもり 05/12/8(木) 9:13 質問[未読]
【32174】Re:ファイル名を取得して,ある列に代入する... にしもり 05/12/8(木) 9:58 質問[未読]
【32176】Re:ファイル名を取得して,ある列に代入する... にしもり 05/12/8(木) 10:08 お礼[未読]
【32178】解決後ですが。 Jaka 05/12/8(木) 10:20 発言[未読]
【32193】Re:解決後ですが。 ponpon 05/12/8(木) 18:39 発言[未読]
【32219】Re:解決後ですが。 にしもり 05/12/9(金) 15:22 お礼[未読]
【32172】ファイル名を取得して,ある列に代入する...
質問  にしもり  - 05/12/8(木) 9:13 -
引用なし
パスワード
   こんにちは。

いま「京都.xls」というファイルがあり、週１で更新されます。
１行目はフイールド名です。
レコード数は毎回定まってはいませんが、A列の２行目以下をカウントすればそれがレコード数となります。
この中のCD列が空白なのを利用して、セルCD2からレコード下端まで「京都」という文字をいれたいのです。

同様に「大阪.xls」というファイルがあり、週１で更新されます。
１行目はフイールド名です。
レコード数は毎回定まってはいませんが、A列の２行目以下をカウントすればそれがレコード数となります。
この中のCD列が空白なのを利用して、セルCD2からレコード下端まで「大阪」という文字をいれたいのです。

更新タイミングは京都、大阪とも同時です。

京都、大阪・・と順番にファイル名を取得して、ファイルを開けて、ファイル名に応じてセルCD2からレコード下端まで文字を入れるのにはどうすればよいでしょうか？
【32174】Re:ファイル名を取得して,ある列に代入す...
質問  にしもり  - 05/12/8(木) 9:58 -
引用なし
パスワード
   ▼にしもり さん：
自己レスです。
ここまで自力でできました。
Sub TEST()

Dim SH1 As Worksheet
Dim MyRow1 As Long
Dim MyVal1 As String

Workbooks.Open Filename:="C:\User\京都.xls"
Workbooks("京都.xls").Activate

With ActiveWorkbook
　 MyVal1 = .Name
End With

Set SH1 = Workbooks("京都.xls").Worksheets("Sheet1")
MyRow1 = SH1.Range("A65536").End(xlUp).Row

For i = 2 To MyRow1
　　SH1.Cells(i, 82) = MyVal1
Next i

End Sub
ですが結果は「京都」でなく「京都.xls」になってしまいます。
頭は２桁と決まっています。
左２桁にするときもっともよい関数はなんですか。
【32176】Re:ファイル名を取得して,ある列に代入す...
お礼  にしもり  - 05/12/8(木) 10:08 -
引用なし
パスワード
   ▼にしもり さん：
自力でできました。
お騒がせしました。
Sub TEST()

Dim SH1 As Worksheet
Dim MyRow1 As Long
Dim MyVal1 As String

Workbooks.Open Filename:="C:\User\京都.xls"
Workbooks("京都.xls").Activate

With ActiveWorkbook
　 MyVal1 = .Name
End With

Set SH1 = Workbooks("京都.xls").Worksheets("Sheet1")
MyRow1 = SH1.Range("A65536").End(xlUp).Row

For i = 2 To MyRow1
　　SH1.Cells(i, 82) = Left(MyVal1, 2)
Next i

ActiveWorkbook.Save
ActiveWorkbook.Close

End Sub
【32178】解決後ですが。
発言  Jaka  - 05/12/8(木) 10:20 -
引用なし
パスワード
   まとまったセル範囲に同じ値を入れるのにループは必要ないです。

例えば
Range("A2:A15").value = "京都"

で、A2:A15に同じ値が入ります。
【32193】Re:解決後ですが。
発言  ponpon  - 05/12/8(木) 18:39 -
引用なし
パスワード
   こんにちは。

>京都、大阪・・と順番にファイル名を取得して、ファイルを開けて、

とあるので、Dir関数で取得して処理したらいかがでしょう？
そのフォルダには、マクロを書いたブックと必要なファイルしかないものとします。


Sub test()
　　Dim myFile As String
　　Dim myVal As String
　　Const myPath As String = "C:\回収\"
　　
　　
　　Application.ScreenUpdating = False
　　myFile = Dir(myPath & "*.xls")
　　Do While myFile <> ""
　　　Workbooks.Open myPath & myFile
　　　With ActiveWorkbook
　　　　If .Name <> ThisWorkbook.Name Then
　　　　　myVal = Left(.Name, 2)
　　　　　.Worksheets(1).Range("CD2", .Cells(.Range("A1").End(xlUp).Row, "CD")) = myVal
　　　　　.Close True
　　　　End If
　　　myFile = Dir()
　　Loop
　　Application.ScreenUpdating = True
　　
End Sub
【32219】Re:解決後ですが。
お礼  にしもり  - 05/12/9(金) 15:22 -
引用なし
パスワード
   ▼jakaさん、ponpon さん：
　　こんにちは。

>京都、大阪・・と順番にファイル名を取得して、ファイルを開けて、

といいましたが結局あらかじめ開けておいて
ひとつひとつアクティヴにしてマクロ実行することにしました。
１０程度しかファイルがないので。

Sub TEST()

Dim SH1 As Worksheet
Dim MyRow1 As Long
Dim Myval1 As String

With ActiveWorkbook
Myval1 = .Name
　　Set SH1 = ActiveWorkbook.Worksheets("Sheet1")
　　MyRow1 = SH1.Range("A65536").End(xlUp).Row
　　For i = 2 To MyRow1
　　　　　　SH1.Cells(i, 82) = Left(Myval1, 2)
　　Next i
ActiveWorkbook.Save
ActiveWorkbook.Close
End With

End Sub


皆様の高度なアドバイスは今の自分には消化できませんが、少しずつ進歩していると思っております。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8626 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free