VBA仙人様ご教授お願い致します。

1フォルダに数十のログファイル(.txt)が格納されています。
1ファイルは3~5万行記述あります。
これを1つのExcelファイルにしたいと思っています。

VBA流れとして
(1)ログ格納フォルダを選択
(2)ログファイル名を取得
(3)既存Excelファイルに(2)で取得したファイル名(.txt除いた)で順次シートを追加
(4)ログファイル=シートとなるようにファイル読み込み/貼り付け
(5)ログファイルを閉じる

VBAイメージ
格納フォルダ:C:\test
\test内    :A001.txt,A002.txt,B003.txt・・・・・・・・Z051.txt(このフォルダにはログのみ格納)
C:デスクトップ\集計マクロ.excel (VBAの記述のあるExcelシートにはSheet1のみが存在)

VBA前
集計マクロ.excel/Sheet1
VBA実行後
集計マクロ.excel/Sheet1,A001,A002,B003,D004・・・・・・・・・Z051が追加、シート毎にログ情報記載

単一ファイルの読み込み/ファイル名をシート名に付与/情報コピペ/ファイル閉じについては、
作成できたのですが、複数ファイルの場合のファイル名を順次取得し、シート名として付与するなど
objやValiant変数などで試行錯誤しましたが解決できず、こちらに質問されていただきました><
このVBAで作成されたシートからの集計マクロについては完成していますが、
その手前でつまづいています><
ご教授のほどお願い致します><

このQ&Aに関連する最新のQ&A

A 回答 (5件)

#3です。


Set destRange = sh.Range("A1").Resize(UBound(buf) + 1, 1)
が正しいです。試験したファイルは最後にもCrLfが入っていたため、見落としてしまい申し訳ありません。
改行コードCrLfが一個も入っていないファイルの場合、UBound(buf)が0となるため、ご指摘のエラーになります。

また、行の区切りがCrLfでない場合は、
Const delimiter As String = vbCrLf
の所を、vbLfなのか、その他の任意の文字か分かりませんが、それに変更する必要があります。

行の区切りと、セルの区切りがある場合は、下記の様にできると思います。ただし、すべての行の要素数が同じとします。
buf = Split(textFile.ReadAll, delimiter)
buf2 = Split(buf(0), cellDelimiter)
Set destRange = sh.Range("A1").Resize(UBound(buf) + 1, UBound(buf2) + 1)
For i = 0 To UBound(buf)
destRange.Rows(i + 1) = Split(buf(i), cellDelimiter)
Next i
    • good
    • 0

ご苦労様です。



単一ファイルでできたのであれば、それをループさせるだけだとは思いますが、
Excelで複数ファイルを立ち上げて「終了」させるにはきちんとExcelオブジェクトを順に終了させていかなければ
できないことがあります。
そのためにはExcelオブジェクトのApp→workbook→worksheet→cellとアクセスし、終了させるときはその逆に終了させていく
(オブジェクトを解放する)ようにしなければExcelが終了しません。

やりたいことはテキストファイルの合体だと思うのですが、既にツールがあります。
    • good
    • 0
この回答へのお礼

助かりました^^ありがとうございます><

お礼日時:2011/09/04 01:43

この手の事はFileSystemObjectを使うと便利です。

詳細は参照URLをご覧下さい。
ファイルリスト取得はDirでも良いのですが、全部FSOでやってみました。
xl2000で試しています(少数&小さなファイルですが...)。ご参考まで。
Sub treatAllFiles()
Dim FSO As Object, targetFolder As Object, targetFile As Object
Dim textFile As Object
Dim folderName As String
Dim sh As Worksheet
Dim destRange As Range
Dim buf As Variant
Const delimiter As String = vbCrLf

folderName = "C:\test"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set targetFolder = FSO.getfolder(folderName)
For Each targetFile In targetFolder.Files
DoEvents '途中でやめたくなった時のための保険
If UCase(FSO.GetExtensionName(targetFile)) = "TXT" Then
Set sh = ThisWorkbook.Sheets.Add
sh.Name = FSO.getbasename(targetFile)
Set textFile = FSO.OpenTextFile(targetFile)
'この部分は速いかなと思って少々奇を衒ってみましたが、メモリ容量上問題が出る場合は、ReadLineで一行ずつ読みこんで処理してください。一行を一つのセルに収納する前提です。複数に分ける場合は、追加の処理が必要です。
buf = Split(textFile.ReadAll, delimiter)
Set destRange = sh.Range("A1").Resize(UBound(buf), 1)
destRange = Application.Transpose(buf)
Set textFile = Nothing
End If
Next targetFile
Set FSO = Nothing
End Sub

参考URL:http://officetanaka.net/excel/vba/filesystemobje …

この回答への補足

ご教授有難うございます。
ご提供いただいたマクロについて一日解読致しました。
私が途中まで自力で作成したものはとてつもない行数のものでした・・・
実データにて検証致しましたが、マクロ内Set destRange = sh.Range("A1").Resize(UBound(buf), 1)のフォルダ内最初のファイル名でシートが作成されたところでで”オブジェクト定義エラー”となりマクロが停止してしまいました。
テキストログ内にはExcelで区切りせりできるよう、Shellでテキスト内にブランクを挿入して分割しています。これがspilt処理の際に支障となり本件のエラーになっているのでしょうか?
引き続きデバッグを試みますが、mitarashiさん方で原因が分かればお時間あるときに教えてください。よろしくお願いします。

補足日時:2011/04/24 22:36
    • good
    • 0

質問の説明が丁寧なのは良いが、くどくてわかりにくい面もある。


課題は単純で
(1)1フォルダのファイル(名)を順次掴む
(2)(1)のファイルのレコードを順次読んで1つにまとめるなり、エクセルのセルに書き出す
それだけでしょう
(1)のコードはWEBに満ち溢れている
なんでGoogleででも「VBA フォルダ ファイル名 取得」などで照会しないのか。
http://itpro.nikkeibp.co.jp/article/COLUMN/20060 … (FSOの例)ほか多数
それと、質問者は、テキストファイルを扱うVBAに慣れていないのだろう。昔のBasic時代は、何をするにもここから始まったのだが。
ーー
下記例では配列に3つのテキストファイルを指定し、エクセルに書き出している例。3つぐらいの例で勉強したり、テストしたり、質問すれば、後は考えを延長すれば仕舞いなのだ。質問には実際をややこしく説明するのは無駄。
下記例を質問者の場合、FSOのFor Eachで、フォルダの中の1ファイルを捕まえたとき、
そのファイルを見つける繰り返しの中で見つかった場所(コード上の)へ、下記のOpenからCloseまでを入れ子にすればしまい。
その時点ではもちろん、f = Array("test01.txt", "test02.txt", "text7.txt") は不要。
ーーー
Sub test01()
f = Array("test01.txt", "test02.txt", "text7.txt")
i = 1
Open "textx.txt" For Append As #2
For Each fl In f
Open fl For Input As #1
While Not EOF(1)
Line Input #1, a
Print #2, a
Cells(i, "A") = a
i = i + 1
Wend
Close #1
Next
Close #2
End Sub
これはインプトファイルの1行=>アウトプットファイルの1行の集積なので、必要があれば、エクセルの「区切り位置」操作で
各フィールド(=列項目)に分けることも出来る。
一旦上記例の"textx.txt"に当たる集積テキストファイルを作って、最後にエクセルに読ませる手もある。
    • good
    • 0
この回答へのお礼

ご教授ありがとうございます。
精進いたします><

お礼日時:2011/04/24 22:02

フォルダ内のファイル名などの情報を取得する方法の一つとして


Dir()関数で調べてみると たくさんヒットします。
一例ですが、新しいシートで
A1セルに C:\test とフォルダを指定しているとして

Sub Sample1()
Dim buf As String, i As Long
i=6
buf = Dir(Range("A1").Value & "\*.txt")
Do While buf <> ""

Cells(i + 1, 1).Value = buf
i = i + 1

buf = Dir()
Loop
End Sub

を試してみてください。
この部分が理解できたら
Cells(i + 1, 1).Value = buf
i = i + 1
の部分に
>単一ファイルの読み込み/ファイル名をシート名に付与/情報コピペ/ファイル閉じについては、
作成できたのですが
のコードを順次実行させるように置き換えます。

この回答への補足

ご回答有難うございます。
今回の構文を私のマクロに取り入れて試行しておりますが、未だ解決できずです。少し頑張って解決してみます。

補足日時:2011/04/24 22:40
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q複数の同じフォーマットのファイルを新しいブックで一つのシートにまとめる方法

仕事で、各部署から送られてきた、同じフォーマットのファイル(シート1にのみデータ有)が50個近くあります。
それを新しいブックで一つのシートにまとめなくてはいけません。
地道にコピペするのは時間がかかるのでマクロで処理を行いたいと思います。
マクロでの処理方法ご存知の方、処理方法の載っているサイトをご存知の方、もしくはマクロより簡単な方法がありましたら教えてください。

あと、逆に一つのシートをいくつかのファイルに振り分けていく方法もご存知でしたら教えて下さい。
よろしくお願いします。

Aベストアンサー

すみません。質問を勘違いしていました。
>新しいブックで一つのシートにまとめなくてはいけません
でしたね。
Sub Sample1()
Dim buf As String, i As Long
Dim j
buf = Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls")
Do While buf <> ""
Workbooks.Open Worksheets("Sheet1").Range("A1").Value & "\" & buf
Sheets("Sheet1").Range("A1:J1000").Copy
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Workbooks(buf).Activate
Application.CutCopyMode = False
Workbooks(buf).Close SaveChanges:=False
buf = Dir()
Loop
End Sub
で試してみてください。使い方などは
http://oshiete1.goo.ne.jp/qa4225063.html
を参照してみてください。同じ質問があったので気がつきました。

すみません。質問を勘違いしていました。
>新しいブックで一つのシートにまとめなくてはいけません
でしたね。
Sub Sample1()
Dim buf As String, i As Long
Dim j
buf = Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls")
Do While buf <> ""
Workbooks.Open Worksheets("Sheet1").Range("A1").Value & "\" & buf
Sheets("Sheet1").Range("A1:J1000").Copy
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Workbooks(buf).Activate
Application.CutCop...続きを読む

Qフォルダ内の全てのBookに同じ処理を繰り返す

フォルダ内にエクセルファイルが約3,000個あります。
この全てのBookに同じ処理をしたいのですが、マクロで繰り返す方法がわからないので教えて下さい。
処理をする内容は簡単なもので、マクロで作りました。

・ 各Bookには1つのシートしか存在せず、シート名は重要ではないので全て「Sheet1」になっています。
・ 各Bookのデータの配置や表形式は同じです。
・ レコードの行数がBookによって異なります。

処理の内容をマクロで作るところまではできましたが、知識がないためタイムアウトです。

ご教示宜しくお願い致します。

Aベストアンサー

だいたいこんな流れで。

sub macro1()
 dim myPath as string
 dim myFile as string

 mypath = "C:\test\"

’指定フォルダのブックを順繰り拾う
 myfile = dir(mypath & "*.xls*")
 do until myfile = ""

 ’ブックを開いて処理を行い保存して閉じる
  workbooks.open mypath & myfile
  activesheet.range("A1") = "DONE"
  activeworkbook.close true

  myfile = dir()
 loop
end sub


必要に応じて
・画面の表示を抑制する
・再計算を手動にする
といった手管を追加して高速化を図ります。

QVBAでフォルダ内の全てのcsvファイルからコピペ

マクロ超初心者です。

フォルダ内のすべてのcvsファイル(500程度)の5列目(500行程度)を新規ファイルの1列目から順にコピーしていきたいのです。

ちなみに元のcvsファイルのシート数は一つだけでシート名には全てファイル名が付いています。
(つまり全てのファイルのシート名が異なる)

見よう見真似で似たようなマクロから意味もわからないまま
つぎはぎして下記作りましたが
やっぱり動きません。

どなたか詳しい方どうかよろしくお願いします。


Sub Sample()
Const FolderPath As String = "C:\data"
Dim objFSO As Object
Dim objBook As Object
Dim lngRow As Long

Application.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objBook In objFSO.GetFolder(FolderPath).Files
lngcolumn = ThisWorkbook.Sheets("sheet1").Range("A" & Columns.Count).End(xlToRight).Column + 1
Workbooks.Open objBook.Path
With ActiveWorkbook
.Worksheets(1).Column("5").Copy ThisWorkbook.Sheets("sheet1").End(xlToRight).Offset(0, 1)
.Close
End With
Next

Set objFSO = Nothing

Application.ScreenUpdating = True

End Sub

マクロ超初心者です。

フォルダ内のすべてのcvsファイル(500程度)の5列目(500行程度)を新規ファイルの1列目から順にコピーしていきたいのです。

ちなみに元のcvsファイルのシート数は一つだけでシート名には全てファイル名が付いています。
(つまり全てのファイルのシート名が異なる)

見よう見真似で似たようなマクロから意味もわからないまま
つぎはぎして下記作りましたが
やっぱり動きません。

どなたか詳しい方どうかよろしくお願いします。


Sub Sample()
Const FolderPath As String = ...続きを読む

Aベストアンサー

私なら、こんな感じで作ります。

Sub test()
Const FolderPath As String = "C:\data"
Dim Filename As String
Dim Sh0 As Worksheet, Sh As Worksheet
Dim c As Long

Set Sh0 = ActiveSheet
Filename = Dir(FolderPath & "\*.csv")
Do Until Filename = ""
c = c + 1
Set Sh = Workbooks.Open(FolderPath & "\" & Filename).Sheets(1)
Sh.Columns(5).Copy Sh0.Columns(c)
Application.DisplayAlerts = False
Sh.Parent.Close
Application.DisplayAlerts = True
Filename = Dir()
Loop
End Sub

私なら、こんな感じで作ります。

Sub test()
Const FolderPath As String = "C:\data"
Dim Filename As String
Dim Sh0 As Worksheet, Sh As Worksheet
Dim c As Long

Set Sh0 = ActiveSheet
Filename = Dir(FolderPath & "\*.csv")
Do Until Filename = ""
c = c + 1
Set Sh = Workbooks.Open(FolderPath & "\" & Filename).Sheets(1)
Sh.Columns(5).Copy Sh0.Columns(c)
Application.DisplayAlerts = False
Sh.Parent.Close
...続きを読む

Q複数のテキストファイルをひとつのエクセルシートにまとめるには?

複数のテキストファイル(.txt)をエクセルのひとつのシートにまとめるにはどうすればいいですか?
またその際、個々のテキストファイルのファイル名を本文の前に挿入したいのですが、
そのやり方も教えていただけると助かります。
ただ、フリーソフトを使わずエクセルの機能だけでやりたいのでよろしくお願いします。
↓のような感じにしたいです。

-------------------------------------------
test1.txt
data data data data data data data data
data data data data data
data data data data data data

test2.txt
data2 data2 data2 data2 data2 data2 data2
data2 data2 data2 data2 data2 data2 data2
data2 data2 data2 data2 data2 data2

-------------------------------------------
Sheet1

現在、一つ一つのテキストファイルの名前をF2で選択してセルに貼り付け、
テキストファイルを開いて本文を前文コピーして貼り付け、というやり方でやってますが、
非常に時間がかかって困っています。
よろしくお願いします。

複数のテキストファイル(.txt)をエクセルのひとつのシートにまとめるにはどうすればいいですか?
またその際、個々のテキストファイルのファイル名を本文の前に挿入したいのですが、
そのやり方も教えていただけると助かります。
ただ、フリーソフトを使わずエクセルの機能だけでやりたいのでよろしくお願いします。
↓のような感じにしたいです。

-------------------------------------------
test1.txt
data data data data data data data data
data data data data data
data data data data d...続きを読む

Aベストアンサー

こんにちは。

#2のWendy02です。返事を待たずに、VBA用のコードを、WSH(Windows Script Host)を意識して、作ってみました。ただし、WSHに換えるためには、細かい点は直さなくてはなりません。

Sub TextFileConbining()
'テキストファイルをファイル名を出力てつなげる
Dim BaseFileName As String
Dim FileName As Variant
Dim fn As Variant
Dim FileNo As Integer
Dim objFSO As Object
Dim objFile As Object
Dim objText As Object
Dim TextLines As String

 Set objFSO = CreateObject("Scripting.FileSystemObject")
 BaseFileName = Application.InputBox("ベース・テキストファイル名をつけてください。" & vbCrLf & "拡張子(.txt)は不要です。", Type:=2)
  If VarType(BaseFileName) = vbBoolean Or BaseFileName = "" Then Exit Sub
 FileName = Application.GetOpenFilename("テキストファイル(*.txt),*.txt", , , , True)
  If VarType(FileName) = vbBoolean Then Exit Sub
 Set objFile = objFSO.OpenTextfile(ThisWorkbook.Path & "\" & BaseFileName & ".txt", 8, True)
 
 For Each fn In FileName
  If fn Like ThisWorkbook.Path & "\" & BaseFileName & ".txt" Then
   MsgBox fn & "は、ベース・テキストファイル名と同じです。" & Chr(13) & "スキップします。", vbInformation
  Else
  objFile.WriteLine (Mid$(fn, InStrRev(fn, "\") + 1) & Chr(13) & Chr(10))
  Set objText = objFSO.OpenTextfile(fn)
  TextLines = objText.ReadAll
  objText.Close
  objFile.Write TextLines
  End If
 Next
 objFile.Close
 Beep '終了の合図
 Set objFile = Nothing: Set objFSO = Nothing
End Sub

こんにちは。

#2のWendy02です。返事を待たずに、VBA用のコードを、WSH(Windows Script Host)を意識して、作ってみました。ただし、WSHに換えるためには、細かい点は直さなくてはなりません。

Sub TextFileConbining()
'テキストファイルをファイル名を出力てつなげる
Dim BaseFileName As String
Dim FileName As Variant
Dim fn As Variant
Dim FileNo As Integer
Dim objFSO As Object
Dim objFile As Object
Dim objText As Object
Dim TextLines As String

 Set objFSO = CreateObject("S...続きを読む

Q大量のCSVデータを1つのエクセルデータにまとめる方法について

今仕事で、CSVファイルが400ファイル程あり、これを一つの
エクセルファイルにまとめなくて加工しなければならないのですが
うまいことVBAを活用して効率的にできないか思案中なのですが
うまい具合に行きません。
データの持ち方として
○CSVファイル1
1.AAA
2.BBB

○CSVファイル2
3.CCC
4.DDD

となっており、これを1つのエクセルファイル上で
1.AAA
2.BBB
3.CCC
4.DDD
としたいのですがなにかいい方法はないでしょうか?
1つのブックで外部データの取り込みでCSVを次々に選択して
いくVBAなんてあれば教えていただけないでしょうか?
よろしくお願いします。

Aベストアンサー

こんにちは。
昔書いた事があるサンプルです。
同一フォルダにあるcsvファイルをまとめて処理します。

Sub CSVまとめsample()
  Dim MyObj As Object
  Dim MyFol As String
  Dim MyFnm As String
  Dim MyStr As String
  Dim i   As Long
  Dim n   As Long
  Dim n1  As Long
  
  'フォルダを選択する
  Set MyObj = CreateObject("Shell.Application") _
    .BrowseForFolder(0, "SelectFolder", 0)
  '選択なければ処理を抜ける
  If MyObj Is Nothing Then Exit Sub
  MyFol = MyObj.self.Path & "\"
  MsgBox MyFol & "を処理します。"
  Set MyObj = Nothing
  Application.ScreenUpdating = False
  'ThisWorkbookにシートを追加して処理
  With Sheets.Add
    'Dir関数を使って指定フォルダ内csvファイルを順次処理
    MyFnm = Dir(MyFol & "*.csv")
    Do Until Len(MyFnm) = 0&
      i = i + 1
      'データエリアを取得してセット先を変更
      n = IIf(n = 0, 1, n + n1)
      '外部データ取り込みを利用
      With .QueryTables.Add(Connection:="TEXT;" & MyFol & MyFnm, _
                 Destination:=.Range("B" & n))
        .AdjustColumnWidth = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileCommaDelimiter = True
        .Refresh False
        n1 = .ResultRange.Rows.Count
        .Parent.Names(.Name).Delete
        .Delete
      End With
      'ファイル名をA列にセット
      .Range("A" & n).Resize(n1).Value = MyFnm
      '次のファイルへ
      MyFnm = Dir()
    Loop
  End With
  If i > 0 Then
    MyStr = i & "個のファイルを処理しました。"
  Else
    '検索結果が0なら
    MyStr = "検索条件を満たすファイルはありません。"
  End If
  Application.ScreenUpdating = True
  MsgBox MyStr
End Sub

#シート行数をオーバーした時のエラー処理などはしてないので
#うまくいかなかったらごめんね^ ^;

こんにちは。
昔書いた事があるサンプルです。
同一フォルダにあるcsvファイルをまとめて処理します。

Sub CSVまとめsample()
  Dim MyObj As Object
  Dim MyFol As String
  Dim MyFnm As String
  Dim MyStr As String
  Dim i   As Long
  Dim n   As Long
  Dim n1  As Long
  
  'フォルダを選択する
  Set MyObj = CreateObject("Shell.Application") _
    .BrowseForFolder(0, "SelectFolder", 0)
  '選択なければ処理を抜ける
  If MyObj Is Nothi...続きを読む

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QエクセルVBAでフォルダ内の全ファイルをコピペ

フォルダ内にあるファイルの内、複数を指定して開いて、任意の部分をコピーし、マスターとなるファイルに貼りつける、という作業をVBAで行いたいと思っています。
VBAを全く知らないため、毎回20近いファイルを手で開いてはコピペしなくてはならず困っております。
●あるフォルダ内にあるファイルの形式は全て同じで、10行目まではタイトル欄になっているため、11行目以降の記載がある行だけをマスターとなるファイルにコピペしたいです。
●マスターも同じく10行目まではタイトル欄なので、11行目以降に、他ファイルの11行目以降の内容をどんどん積み上げていく形式にしたいです。
●ファイルの名前は毎回変わるので、フォルダ内の指定されたエクセルファイルのみをコピペ、のような処理にしたいです。
●B列だけは必ず記載がある列なので、そこを参考に11行目から何行目までをコピーすればいいのかを判断できるのかな、と思います。
●貼り付けが完了したらマスター以外の開いたファイルを全て閉じるところまで自動化できたら有難いです。
全くの初心者なため、貼り付けるだけで動くようなものをいただけれると大変助かります。
よろしくお願いいたします。

フォルダ内にあるファイルの内、複数を指定して開いて、任意の部分をコピーし、マスターとなるファイルに貼りつける、という作業をVBAで行いたいと思っています。
VBAを全く知らないため、毎回20近いファイルを手で開いてはコピペしなくてはならず困っております。
●あるフォルダ内にあるファイルの形式は全て同じで、10行目まではタイトル欄になっているため、11行目以降の記載がある行だけをマスターとなるファイルにコピペしたいです。
●マスターも同じく10行目まではタイトル欄なので、11行目以降に、他ファイ...続きを読む

Aベストアンサー

>全くの初心者なため、貼り付けるだけで動くようなものをいただけれると大変助かります。
そこまで甘えないことが上達の早道です。

同じような質問が良くありますよ。最近回答した質問ですが
http://oshiete.goo.ne.jp/qa/7578876.html
http://oshiete.goo.ne.jp/qa/4221547.html
を参考にしてみてください。とは云っても少し、説明しておきますと
●あるフォルダ内にあるファイルの形式は全て同じで、10行目まではタイトル欄になっているため、11行目以降の記載がある行だけをマスターとなるファイルにコピペしたいです。
Sheets("Sheet1").Range("A1:J1000").Copy
の部分が Sheets("Sheet1").Range("A11:J1000").Copy
にすると、11行目からJ1000までに という事になります。
デーやが入っている最終の行を取得する方法はありますが、データを元データの行数がたいしたことなければ

元データが最大1000行までであれば
Range("A1:J1000").Copy
と指定しても、空白がコピーされるだけですので十分ではあります。

●マスターも同じく10行目まではタイトル欄なので、11行目以降に、他ファイルの11行目以降の内容をどんどん積み上げていく形式にしたいです。
Range("A65536").End(xlUp).Offset(1, 0).Select
がA列の最終の行から上へ検索してデータの入っている行の下を探しています。

●ファイルの名前は毎回変わるので、フォルダ内の指定されたエクセルファイルのみをコピペ、のような処理にしたいです。
Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls")
で指定したフォルダのエクセルファイルを順に取得しています。

●B列だけは必ず記載がある列なので、そこを参考に11行目から何行目までをコピーすればいいのかを判断できるのかな、と思います。
Range("A65536").End(xlUp).Offset(1, 0).Select

Range("B65536").End(xlUp).Offset(1, 0).Select
とするとB列の最終行を取得できます。
*但し、B65536 はエクセル2003以前のヴァージョンの最大65536行なので、この様になっています。
エクセル2007以上であれば、 65536 の値が異なります。
バージョンを問わずという事であれば、最終の行を取得する方法があります。


●貼り付けが完了したらマスター以外の開いたファイルを全て閉じるところまで自動化できたら有難いです。
Workbooks(buf).Close SaveChanges:=False
の部分が、上書き保存せずに 閉じる という事です。
更に検討が必要な部分としては、貼り付けの作業を行った後のファイルをどうするかです。
そのままでは、VBAを実行するたびにデータが追加されますしね。
解決案
コピーが終了したら、ファイルごと削除、ほかのフォルダーへ移動させる。

或いは、
データの部分(11行目以下)を削除して保存していく。

或いは、
VBA実行前に、マスターのデータをクリアして、毎回、全てのファイルのデータを
貼り付ける。

とりあえず、ここまでにしておきます。

>全くの初心者なため、貼り付けるだけで動くようなものをいただけれると大変助かります。
そこまで甘えないことが上達の早道です。

同じような質問が良くありますよ。最近回答した質問ですが
http://oshiete.goo.ne.jp/qa/7578876.html
http://oshiete.goo.ne.jp/qa/4221547.html
を参考にしてみてください。とは云っても少し、説明しておきますと
●あるフォルダ内にあるファイルの形式は全て同じで、10行目まではタイトル欄になっているため、11行目以降の記載がある行だけをマスターとなるファイルにコピペし...続きを読む

QVBAであるマクロを全てのシートに対して流したい

お世話になります。

現在シート単位に実行するマクロ1があります。

これを、全てのシートに対して、マクロ1を実行したいのですが、どのようにすればよいでしょうか?
※現在は、シートが終わる毎に手動でマクロ1を実行して、それが終われば次のシートへという形です。

大変お手数ですが、何卒よろしくお願いします。

Aベストアンサー

全てのシートに同じマクロ、ということは
そのマクロはアクティブシートに対して処理してるはずですから
該当シートをアクティブにしながら実行されなければいけないので
以下のようになります。

'-------------------------------------------
Sub Test()
Application.ScreenUpdating = False
 Dim Sht As Worksheet
   For Each Sht In Worksheets
     Sht.Select
     Call マクロ1
   Next Sht
Application.ScreenUpdating = True
End Sub
'--------------------------------------

全てのシートをアクティブにしながら実行しますので画面がちらつきます。
それを抑えるのが、ScreenUpdatingメソッドです。

違いを見る為に最初は、それを抜いて実行してみてください。

 

全てのシートに同じマクロ、ということは
そのマクロはアクティブシートに対して処理してるはずですから
該当シートをアクティブにしながら実行されなければいけないので
以下のようになります。

'-------------------------------------------
Sub Test()
Application.ScreenUpdating = False
 Dim Sht As Worksheet
   For Each Sht In Worksheets
     Sht.Select
     Call マクロ1
   Next Sht
Application.ScreenUpdating = True
End Sub
'------------------------------...続きを読む

Q複数テキストファイルをエクセルで開く

度々の質問申し訳ございません。

複数のテキストファイルが入ったフォルダ内のすべてのテキストデータをエクセルの1シートで開きたいです。

他の方の同じような質問の御回答に以下のようなマクロが有りました。
Sub macro1()
Dim myPath As String
Dim myFile As String
Dim n, c, s

'初期化
myPath = ThisWorkbook.Path & "\"
myFile = Dir(myPath & "*.txt")

'受入準備
On Error Resume Next
Worksheets.Add before:=Worksheets(1)
ActiveSheet.Name = Format(Date, "yyyymmdd")
On Error GoTo 0

'ファイルの巡回
Do Until myFile = ""
n = n + 1
Cells(n, "A") = myFile

'データの読み出し
Open myPath & myFile For Input As #1
c = 1
Do Until EOF(1)
Line Input #1, s
c = c + 1
Cells(n, c) = s
Loop
Close #1

myFile = Dir()
Loop
End Sub

これを利用させていただいて、テキストファイルを開いたのですが、こちらのマクロですとテキストデータの1列目しか開く事が出来ません。(図参照)
1列目2列目共に開くには何処を変更すれば良いですか?
マクロはまったく理解できないので、何卒宜しくお願い致します。

また、できればエクセルの横方向に開くのではなく、縦方向に開けるようにして頂けると非常にありがたいです。

何卒宜しくお願い致します。

度々の質問申し訳ございません。

複数のテキストファイルが入ったフォルダ内のすべてのテキストデータをエクセルの1シートで開きたいです。

他の方の同じような質問の御回答に以下のようなマクロが有りました。
Sub macro1()
Dim myPath As String
Dim myFile As String
Dim n, c, s

'初期化
myPath = ThisWorkbook.Path & "\"
myFile = Dir(myPath & "*.txt")

'受入準備
On Error Resume Next
Worksheets.Add before:=Worksheets(1)
ActiveSheet.Name = Format(Date, "yyyymmdd")
On Error...続きを読む

Aベストアンサー

>マクロはまったく理解できないので、何卒宜しくお願い致します。
なら、テキストファイルがいくつあるのかわかりませんが、先にひとつのファイルにしちゃうとか。
ただし、EXCELの扱える行数には制限があるので注意してください。
(だからお使いのOSやEXCELのバージョンは書いておくほうが良い)

1)お使いのOSが不明だけど、たぶんアクセサリの中にある「コマンドプロンプト」を開く。
2)黒地に白字の画面になるので、キー入力で右のカッコ内を打つ。 [cd /d ]
3)対象ファイルがあるフォルダのフォルダアイコンを2)へドラッグ&ドロップ。
4)[cd /d C:\xxxxx] みたいになるので、キーボードの[Enter]を押下
5)キー入力で右のカッコ内を打つ。 [copy /b *.txt TextAll.tx] ←最後はtxです
6)「1個のファイルをコピーしました」と表示されるはず。
7)キー入力で右のカッコ内を打つ。 [ren TextAll.tx TextAll.txt] ←最後はtxtです
8)EXCELで対象ファイルがあるフォルダのファイル[TextAll.txt]を開く。

例示のVBAを修正するのであれば
Do Until EOF(1)
 Line Input #1, s
 c = c + 1
 Cells(n, c) = s
 Loop
Close #1

Do Until EOF(1)
 Line Input #1, s
 n = n + 1
 Cells(n, c) = s
 Loop
Close #1
にしてください。

>マクロはまったく理解できないので、何卒宜しくお願い致します。
なら、テキストファイルがいくつあるのかわかりませんが、先にひとつのファイルにしちゃうとか。
ただし、EXCELの扱える行数には制限があるので注意してください。
(だからお使いのOSやEXCELのバージョンは書いておくほうが良い)

1)お使いのOSが不明だけど、たぶんアクセサリの中にある「コマンドプロンプト」を開く。
2)黒地に白字の画面になるので、キー入力で右のカッコ内を打つ。 [cd /d ]
3)対象ファイルがあるフォルダのフ...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報