Excel VBA質問箱 IV

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

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


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

3683 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

▼

【60729】わかりません。 お願いします 09/3/11(水) 19:39

【60730】Re:わかりません。 kanabun 09/3/11(水) 20:16

【60740】Re:わかりません。 質問者 09/3/12(木) 14:22

【60741】Re:わかりません。 kanabun 09/3/12(木) 14:39

【60743】Re:わかりません。 kanabun 09/3/12(木) 15:46

【60744】Re:わかりません。 感謝いたします。 09/3/12(木) 16:53


	【60729】わかりません。

お願いします - 09/3/11(水) 19:39 -


	引用なし

	パスワード

1.指定フォルダの更新日の新しいCSVファイルを取得
2.このCSVファイルをTXTファイルで開き、ＥＸＣＥＬ化
　
　※列は４列、行は1000程度

3.取得したいデータは、
　4列目の最終行

これをＳｈｅｅｔ１のどこでもいいので貼り付ける。

1.の取得は分かりましたが、2.が分かりません。

申し訳ございませんが、お力をお貸し頂けないでしょうか。


	【60730】Re:わかりません。

kanabun - 09/3/11(水) 20:16 -


	引用なし

	パスワード

▼お願いしますさん：
こんばんは。

>1.指定フォルダの更新日の新しいCSVファイルを取得
>2.このCSVファイルをTXTファイルで開き、ＥＸＣＥＬ化
>　
>　※列は４列、行は1000程度
>
>3.取得したいデータは、
>　4列目の最終行
>
>これをＳｈｅｅｔ１のどこでもいいので貼り付ける。
>
>
>1.の取得は分かりましたが、2.が分かりません。

最終行の最終列だけ取得できればいいのなら、手順 2. は不要なのでは？

一例です。
Sub Test1()
　　Dim myText As String
　　'(1)
　　myText = "指定フォルダの更新日の新しいCSVファイル"
　　
　　'(2) 不要につき割愛
　　
　　'(3) 最終行の最終列のあたい
　　Dim io As Integer
　　Dim buf() As Byte
　　Dim j As Long
　　Dim v
　　Dim data
　　　'ファイルを開く
　　　io = FreeFile()
　　　Open myText For Binary As io
　　　ReDim buf(1 To LOF(io))
　　　Get #io, , buf　　　　　 '---全データを読み込む(Shift-JIS)
　　　Close io
　　　v = Split(StrConv(buf, vbUnicode), vbCrLf)'---Unicodeに変換後、
　　　　　　　　　　　　　　　　　　　　　　'改行コードで行に分割
　　　data = v(UBound(v) - 1)　　　　　　　 '最終行データ
　　　j = InStrRev(data, ",")　　　　　　　 'お尻からカンマを探す
　　　data = Mid$(data, j + 1)　　　　　　　'最後のカンマ以降のdata
　　　Worksheets("Sheet1").Range("A1").Value = data 'Sheetに貼り付ける
　　
End Sub


	【60740】Re:わかりません。

質問者 - 09/3/12(木) 14:22 -


	引用なし

	パスワード

▼kanabun さん：

ありがとうございます。
エラーが起こります。

<初期省略>

'ファイルを開く
　　　io = FreeFile()
　　　Open myText For Binary As io
　　　ReDim buf(1 To LOF(io))　　←ここの部分でエラーが発生いたします。
　　　Get #io, , buf　　

申し訳ございません。
私の知識不足で、下記VBAと求めたいCSVファイルをどのように結びつけたらいいのか分かりません。
できることならば、シート１には結果のみ貼り付けたいです。
他の作業はPC内で済ませたいと思っております。

お願い致します。
>▼お願いしますさん：
>こんばんは。
>
>>1.指定フォルダの更新日の新しいCSVファイルを取得
>>2.このCSVファイルをTXTファイルで開き、ＥＸＣＥＬ化
>>　
>>　※列は４列、行は1000程度
>>
>>3.取得したいデータは、
>>　4列目の最終行
>>
>>これをＳｈｅｅｔ１のどこでもいいので貼り付ける。
>>
>>
>>1.の取得は分かりましたが、2.が分かりません。
>
>最終行の最終列だけ取得できればいいのなら、手順 2. は不要なのでは？
>
>一例です。
> Sub Test1()
>　　Dim myText As String
>　　'(1)
>　　myText = "指定フォルダの更新日の新しいCSVファイル"
>　　
>　　'(2) 不要につき割愛
>　　
>　　'(3) 最終行の最終列のあたい
>　　Dim io As Integer
>　　Dim buf() As Byte
>　　Dim j As Long
>　　Dim v
>　　Dim data
>　　　'ファイルを開く
>　　　io = FreeFile()
>　　　Open myText For Binary As io
>　　　ReDim buf(1 To LOF(io))
>　　　Get #io, , buf　　　　　 '---全データを読み込む(Shift-JIS)
>　　　Close io
>　　　v = Split(StrConv(buf, vbUnicode), vbCrLf)'---Unicodeに変換後、
>　　　　　　　　　　　　　　　　　　　　　　'改行コードで行に分割
>　　　data = v(UBound(v) - 1)　　　　　　　 '最終行データ
>　　　j = InStrRev(data, ",")　　　　　　　 'お尻からカンマを探す
>　　　data = Mid$(data, j + 1)　　　　　　　'最後のカンマ以降のdata
>　　　Worksheets("Sheet1").Range("A1").Value = data 'Sheetに貼り付ける
>　　
> End Sub


	【60741】Re:わかりません。

kanabun - 09/3/12(木) 14:39 -


	引用なし

	パスワード

▼質問者さん： >エラーが起こります。 > ><初期省略> > >'ファイルを開く >　　　io = FreeFile() >　　　Open myText For Binary As io >　　　ReDim buf(1 To LOF(io))　　←ここの部分でエラーが発生いたします。 >　　　Get #io, , buf　　推測ですが、 >　　myText = "指定フォルダの更新日の新しいCSVファイル" 変数 myText に手順(1)で求めた最新のCSVファイル名が入ってなくて、ありもしないファイル名を Open してしまって、ファイルサイズLOF(io) がゼロの状態なのでしょう。　ReDim buf(1 To 0) は、ありえない配列の宣言ですから。 myText には別スレで求めた最新のCSVファイル名を（フルパスで）代入してください。


	【60743】Re:わかりません。

kanabun - 09/3/12(木) 15:46 -


	引用なし

	パスワード

前スレの指定フォルダ内の最新のCSVファイルを見つけるコードと
今回の最終行の最終列データだけ取得するコードを合成すると
こんな感じです。

適当にアレンジしてください。

Sub Try2()
'--------------------------　Sub Try1() -----------------------
　　Const myPath = "D:\(Data)\" '検索フォルダ（最後は \）要変更
　　Dim myFile As String
　　Dim LastFile As String
　　Dim fDate As Date, LastDate As Date
　
　　myFile = Dir$(myPath & "*.csv")
　　Do While Len(myFile)
　　　　fDate = FileDateTime(myPath & myFile)
　　　　If LastDate < fDate Then
　　　　　　LastDate = fDate
　　　　　　LastFile = myFile
　　　　End If
　　　　myFile = Dir$()
　　Loop
　　If MsgBox("最新のCSVファイルは" & vbCr _
　　　　　& LastFile & vbTab & LastDate & vbCr _
　　　　　& "です" & vbCr _
　　　　　& "ファイルから最終行、最終列データを読み取りますか？", _
　　　　　vbOKCancel) = vbCancel Then Exit Sub

'---------------------------------------------------------------
　　'最終行の最終列の値だけをシートに書き出す
　　Dim io As Integer
　　Dim buf() As Byte
　　Dim j As Long
　　Dim v
　　Dim data
　　　'ファイルを開く
　　　io = FreeFile()
　　　Open myPath & LastFile For Binary As io
　　　ReDim buf(1 To LOF(io))
　　　Get #io, , buf
　　　Close io
　　　v = Split(StrConv(buf, vbUnicode), vbCrLf)
　　　data = v(UBound(v) - 1)
　　　j = InStrRev(data, ",")
　　　data = Mid$(data, j + 1)
　　　Worksheets("Sheet1").Range("A1").Value = data

　　MsgBox data & " を[A1]に代入しました"
　　
End Sub


	【60744】Re:わかりません。

感謝いたします。 - 09/3/12(木) 16:53 -


	引用なし

	パスワード

▼kanabun さん：

もうなんとお返ししたらいいのやら・・・
完璧です。
あとは、工夫いたします。

また、別レスについてもバレていましたか・・・
ありがとうございます。
ほんと思い通りの完璧のマクロができました。

>前スレの指定フォルダ内の最新のCSVファイルを見つけるコードと
>今回の最終行の最終列データだけ取得するコードを合成すると
>こんな感じです。
>
>適当にアレンジしてください。
>
> Sub Try2()
> '--------------------------　Sub Try1() -----------------------
>　　Const myPath = "D:\(Data)\" '検索フォルダ（最後は \）要変更
>　　Dim myFile As String
>　　Dim LastFile As String
>　　Dim fDate As Date, LastDate As Date
>　
>　　myFile = Dir$(myPath & "*.csv")
>　　Do While Len(myFile)
>　　　　fDate = FileDateTime(myPath & myFile)
>　　　　If LastDate < fDate Then
>　　　　　　LastDate = fDate
>　　　　　　LastFile = myFile
>　　　　End If
>　　　　myFile = Dir$()
>　　Loop
>　　If MsgBox("最新のCSVファイルは" & vbCr _
>　　　　　& LastFile & vbTab & LastDate & vbCr _
>　　　　　& "です" & vbCr _
>　　　　　& "ファイルから最終行、最終列データを読み取りますか？", _
>　　　　　vbOKCancel) = vbCancel Then Exit Sub
>
> '---------------------------------------------------------------
>　　'最終行の最終列の値だけをシートに書き出す
>　　Dim io As Integer
>　　Dim buf() As Byte
>　　Dim j As Long
>　　Dim v
>　　Dim data
>　　　'ファイルを開く
>　　　io = FreeFile()
>　　　Open myPath & LastFile For Binary As io
>　　　ReDim buf(1 To LOF(io))
>　　　Get #io, , buf
>　　　Close io
>　　　v = Split(StrConv(buf, vbUnicode), vbCrLf)
>　　　data = v(UBound(v) - 1)
>　　　j = InStrRev(data, ",")
>　　　data = Mid$(data, j + 1)
>　　　Worksheets("Sheet1").Range("A1").Value = data
>
>　　MsgBox data & " を[A1]に代入しました"
>　　
> End Sub


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

3683 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free