Results of 1 - 1 of about 1385 for ������������ #N/A (0.016 sec.)
- [[20170805222537]]
- #score: 6930
- @digest: 90af969b2faf015d58f86096391cc96c
- @id: 74130
- @mdate: 2017-08-07T09:25:43Z
- @size: 15393
- @type: text/plain
- #keywords: 号通 (53339), 通信 (48999), 先電 (39789), 信年 (38744), 信開 (33166), 信先 (30071), 信料 (29010), 狭山 (22788), マホ (21501), myfld (20686), 当無 (20440), properties (19285), 信時 (14579), 090 (12912), mydir (12337), extended (12247), 話番 (10327), 電話 (9026), ト!$ (8543), 1234 (8198), スマ (8193), 234 (8009), filedialog (7415), 2017 (5527), cn (5093), rs (4992), desktop (4594), 始時 (2973), activate (2894), 日) (2737), nothing (2579), createobject (2116)
- 『フォルダーの中にあるCSVファイルのシートデータをコピー』（狭山）
お世話になっております。 どうぞよろしくお願いいたします。 携帯管理簿と名前のフォルダーがあります。 その中にファイル名がバラバラなCSVファイルが数十個あり 各ファイルの中のシートは1つしかないのですが名前もバラバラです。 また、各シートのデータ数量（行）も違います。 行いたいことですが 1、新規で作成したエクセルファイルを開きます 2、マクロを実行すると”フォルダーの参照画面が出てきて 携帯管理簿と名前のフォルダーを選択 3、各ファイルのシートのA〜Iに入っているデータを下記のようにコピー A B C D E F G H I 1 電話番号 通信年月日 曜日 通信開始時刻 通信先電話番号 通信先 通信時間 通信料 通信種類 2 090-1234-5678 2017/6/5 月 9:16 01-234-5678 東京 00:44.5 100 スマホ 3 090-1234-5679 2017/6/5 月 9:18 01-234-5679 神奈川 00:28.0 100 スマホ 4 090-1234-5680 2017/6/5 月 10:19 01-234-5680 千葉 05:13.5 100 スマホ 5 090-1234-5681 2017/6/5 月 10:35 01-234-5681 埼玉 01:20.0 100 スマホ A B C D E F G H I 1 電話番号 通信年月日 曜日 通信開始時刻 通信先電話番号 通信先 通信時間 通信料 通信種類 2 090-1234-5682 2017/6/5 月 11:40 01-234-5682 東京 03:13.5 100 スマホ 3 090-1234-5683 2017/6/5 月 13:10 01-234-5683 神奈川 00:32.5 100 スマホ A B C D E F G H I 1 電話番号 通信年月日 曜日 通信開始時刻 通信先電話番号 通信先 通信時間 通信料 通信種類 2 090-1234-5684 2017/6/5 月 13:44 01-234-5684 千葉 01:17.5 100 スマホ 3 090-1234-5685 2017/6/5 月 14:19 01-234-5685 埼玉 00:48.0 100 スマホ 4 090-1234-5686 2017/6/5 月 15:05 01-234-5686 東京 00:18.5 100 スマホ マクロ実行後 A B C D E F G H I 1 電話番号 通信年月日 曜日 通信開始時刻 通信先電話番号 通信先 通信時間 通信料 通信種類 2 090-1234-5678 2017/6/5 月 9:16 01-234-5678 東京 00:44.5 100 スマホ 3 090-1234-5679 2017/6/5 月 9:18 01-234-5679 神奈川 00:28.0 100 スマホ 4 090-1234-5680 2017/6/5 月 10:19 01-234-5680 千葉 05:13.5 100 スマホ 5 090-1234-5681 2017/6/5 月 10:35 01-234-5681 埼玉 01:20.0 100 スマホ 6 090-1234-5682 2017/6/5 月 11:40 01-234-5682 東京 03:13.5 100 スマホ 7 090-1234-5683 2017/6/5 月 13:10 01-234-5683 神奈川 00:32.5 100 スマホ 8 090-1234-5684 2017/6/5 月 13:44 01-234-5684 千葉 01:17.5 100 スマホ 9 090-1234-5685 2017/6/5 月 14:19 01-234-5685 埼玉 00:48.0 100 スマホ 10 090-1234-5686 2017/6/5 月 15:05 01-234-5686 東京 00:18.5 100 スマホ どうぞご教授お願いいたします。 ＜ 使用 Excel:Excel2013、使用 OS:Windows7 ＞ ---- まずは、一つのVSVファイルを開いて、コピーするマクロを考えるとよいです。 （マナ） 2017/08/05(土) 22:50 ---- ご返信ありがとうございました。 Sub Macro1() ' ' Macro1 Macro ' ' Range("A1:I91").Select Selection.Copy Windows("Book1").Activate ActiveSheet.Paste End Sub 新規Book1を仮に作りまして携帯管理簿のフォルダーの中にあるファイルの1つのシートを コピーして貼り付けの記録を行いました。 後はどうすればよろしいのでしょうか。 ご教授願います。 （狭山） 2017/08/05(土) 23:17 ---- では、CSVを開くところから理解が必要ですね。 特定のフォルダの特定の名前のファイルを開くマクロです。 ***部分は、修正してから、試してみてください。 Option Explicit Sub test() Dim myFld As String, myCSV As String myFld = "C:¥***:¥***¥" myCSV = "******.csv" Workbooks.Open myFld & myCSV End Sub （マナ） 2017/08/06(日) 00:01 ---- この流れからすると少し空気を読めてないような気がするのですが、一応作ってみたので、載せておきます(動作の確認はできていないのでエラーがあるかもしれません)。 フォルダ内の全てのCSVファイルを開くのは、エクセルの機能だけではできないので、FileSystemObjectというものを使います。詳細はネットで調べてみてください。 詳しい説明は敢えてしません。FileDialog,FileSystemObject,セルの選択方法,Sortメソッドなどを調べてみて、自分で読み解いてください。それでもわからないことがあったら言ってください。 以下がコードの骨格です。エラー処理はしていないので、必要があれば付け足してください。 ---- Option Explicit Sub CopyFromFiles() Dim dlg As FileDialog, fpath As String Dim fso As Object, fc As Object, f As Object Dim wb As Workbook, ws As Worksheet Dim csv As Workbook, hyou As Worksheet, buf As Variant Set dlg = Application.FileDialog(msoFileDialogFolderPicker) With dlg .AllowMultiSelect = False .Title = "フォルダーの参照" .Filters.Clear If .Show = False Then Exit Sub End If fpath = .SelectedItems(1) End With Set dlg = Nothing Application.ScreenUpdating = False Set wb = Workbooks.Add Set ws = wb.Worksheets(1) buf = Array("電話番号", "通信年月日", "曜日", "通信開始時刻", "通信先電話番号", "通信先", "通信時間", "通信料", "通信種類") ws.Range(Cells(1, 1), Cells(1, 9)) = buf Set fso = CreateObject("Scripting.FileSystemObject") Set fc = fso.GetFolder(fpath).Files For Each f In fc If fso.GetExtensionName(f.Path) = "csv" Then Set csv = Workbooks.Open(f.Path) Set hyou = csv.Worksheets(1) hyou.Activate hyou.Range(Cells(2, 1), Cells(2, 1).End(xlDown).End(xlToRight)).Copy Set hyou = Nothing ws.Activate ws.Cells(1, 1).End(xlDown).End(xlToRight).Activate ActiveCell.Offset(1, 0).Activate ws.Paste csv.Close False Set csv = Nothing End If Next Set f = Nothing Set fc = Nothing Set fso = Nothing ws.Range(Cells(1, 1), Cells(1, 1).End(xlDown).End(xlToRight)).Sort ws.Cells(1, 4) Set ws = Nothing wb.Activate Set wb = Nothing Application.ScreenUpdating = True MsgBox "完了しました" End Sub （:;:;:;:;:;） 2017/08/06(日) 00:46 ---- （:;:;:;:;:;）さんありがとうございました。 FileSystemObjectとFileDialog,FileSystemObject,のことですが ダイアログで指定したフォルダの中のファイル一覧を取得する とかいろいろとあって理解が出来ませんでした。 （:;:;:;:;:;）さんの教えていただいたマクロを実行すると ActiveCell.Offset(1, 0).Activateの部分がエラーとなってしまいます。 （マナ）さまの教えていただきました方ですが myFld = "C:¥***:¥***¥" ←C:¥Users¥PCUSER¥Desktopと変更しました myCSV = "******.csv" ←実際のCSVのファイル名を入れてみましたが Workbooks.Open myFld & myCSVにエラーが出てしまいます。 ご教授お願いいたします。 （狭山） 2017/08/06(日) 10:04 ---- 横から失礼します。 >myFld = "C:¥***:¥***¥" ←C:¥Users¥PCUSER¥Desktopと変更しました ↓のようにしましたか? myFld = "C:¥Users¥PCUSER¥Desktop¥" ↓になってませんか? myFld = "C:¥Users¥PCUSER¥Desktop" （カリーニン） 2017/08/06(日) 10:08 ---- myFld = "C:¥Users¥PCUSER¥Desktop¥" の代りに myFld = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "¥" としてもいいですね。 （カリーニン） 2017/08/06(日) 10:20 ---- これで試してください。 Sub test() Dim cn As Object, rs As Object, myDir As String, fn As String, n As Long With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then myDir = .SelectedItems(1) & "¥" End With If myDir = "" Then Exit Sub Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") With cn .Provider = "Microsoft.ACE.OLEDB.12.0" .Properties("Extended Properties") = "Text;HDR=NO" End With n = 1 fn = Dir(myDir & "*.csv") Do While fn <> "" cn.Open myDir cn.CursorLocation = 3 Set rs = cn.Execute("SELECT * FROM " & fn) Cells(n, 1).CopyFromRecordset rs n = n + rs.RecordCount rs.Close: cn.Close cn.Properties("Extended Properties") = "Text;HDR=YES" fn = Dir Loop Set cn = Nothing: Set rs = Nothing End Sub （ seiya） 2017/08/06(日) 10:56 ---- ごめんなさい。おかしなことをしていました。 ws.Cells(1, 1).End(xlDown).End(xlToRight).Activate ActiveCell.Offset(1, 0).Activate ↓ If ws.Cells(2, 1) = "" Then ws.Cells(2, 1).Activate Else ws.Cells(2, 1).End(xlDown).Offset(1, 0).Activate End If （:;:;:;:;:;） 2017/08/06(日) 11:08 ---- （カリーニン）さん（ seiya）さん（:;:;:;:;:;）さん（マナ）さん 皆さん本当にありがとうございます。 （:;:;:;:;:;）さんのを実行しましたがデータの移行はできました。 しかし、タイトル行が最終列にきてしまいまして。 （カリーニン）さんの myFld = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "¥"で開きました。 でも、今回は（ seiya）さんのマクロを使用させていただきたいと思います （ seiya）さんのマクロの式でご質問があるのですが たとえば、今回はフォルダーの中にCSVファイルでしたが エクセルファイルの場合どこを変更すれば使用できますでしょうか。 (とても便利で活用性があるためにお聞きしたく） また、大変申し訳がないのですが1つ忘れていたことがありまして マクロ実行後、AとEは電話番号が転記されますが AとEの番号が誰の番号かをリストと言う別のシート名を参考に R列とS列に表示が出来ればと 例 A B C D 1 電話番号 使用者 通信先電話番号 使用者 2 090-1234-5678 A氏01 01-234-5678 E氏05 3 090-1234-5680 B氏01 01-234-5680 F氏06 4 080-1234-0000 C氏03 080-1234-0000 G氏07 5 080-1234-0001 D氏04 080-1234-0001 H氏08 マクロ実行後に、別のリストシート（上記）に基づきR列とS列に結果を表示させたいのですが A E R列 S列 1 電話番号 通信先電話番号 2 090-1234-5678 01-234-5678 A氏01 E氏05 3 090-1234-5679 01-234-5679 該当無し 該当無し 4 090-1234-5680 01-234-5680 B氏01 F氏06 5 090-1234-5681 01-234-5681 該当無し 該当無し 1回で質問できなくて大変申し訳ございませんが ご教授お願いいたします。 （狭山） 2017/08/06(日) 17:19 ---- 1) "Text;HDR=NO" を "Excel 12.0;HDR=No;" に変更してください。 HDR=YES の場合は2行目から、NOの場合は1行目からになります。 2) Set rs = cn.Execute("SELECT * FROM " & fn) fn の部分はシート名をかぎかっこで括って$を付与した形になります。 例:シート名がSheet1の場合 "SELECT * FROM [Sheet1$]" 3) >R列とS列に結果を表示させたいのですが VLookup関数でなんとかなりませんか? （ seiya） 2017/08/06(日) 18:51 ---- 有難うございます。 早速、先ほどのCSVファイルをエクセルファイルに変更し行いましたが 実行後はシート一面何も表示されません。 以下に変更したのですが。 Sub test() Dim cn As Object, rs As Object, myDir As String, fn As String, n As Long With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then myDir = .SelectedItems(1) & "¥" End With If myDir = "" Then Exit Sub Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") With cn .Provider = "Microsoft.ACE.OLEDB.12.0" .Properties("Extended Properties") = "Excel 12.0;HDR=No;" End With n = 1 fn = Dir(myDir & "*.csv") Do While fn <> "" cn.Open myDir cn.CursorLocation = 3 Set rs = cn.Execute("SELECT * FROM " & fn) Cells(n, 1).CopyFromRecordset rs n = n + rs.RecordCount rs.Close: cn.Close cn.Properties("Extended Properties") = "Text;HDR=YES" fn = Dir Loop Set cn = Nothing: Set rs = Nothing End Sub 3) >R列とS列に結果を表示させたいのですが VLookup関数でなんとかなりませんか? R2=IF(A2="","",VLOOKUP(A2,リスト!$A:$B,2,FALSE)) S2=IF(A2="","",VLOOKUP(A2,リスト!$A:$B,2,FALSE)) こちらで出来ました。 ただ、マクロで出来るかと思ったもので。 申し訳ございませんが、前題の件、ご教授お願いいたします。 （狭山） 2017/08/06(日) 20:19 ---- おっと、 fn = Dir(myDir & "*.csv") これも fn = Dir(myDir & "*.xls") に変更ですね。 （ seiya） 2017/08/06(日) 20:39 ---- 数式が判明すれば fn = Dir Loop '↓ ここから With Cells(1).CurrentRegion.Columns("R:S") .Offset(1).Resize(.Rows.Count-1).Formula = _ Array("=IF(A2="""","""",VLOOKUP(A2,リスト!$A:$B,2,FALSE))","=IF(A2="""","""",VLOOKUP(A2,リスト!$A:$B,2,FALSE))") End with '↑ここまで Set cn = Nothing: Set rs = Nothing を追加すればいいと思いますが... （ seiya） 2017/08/06(日) 20:48 ---- 有難うございます。 fn = Dir(myDir & "*.xls")に変更してみたのですが cn.Open myDirが黄色くなってしまいやはり駄目でした。 また先ほどの私が出来ましたと言ったVLookup式ですが リストのA列に該当の電話番号がない場合 R S は#N/Aになってしまいますので、A列に該当の電話番号がない場合は”該当無し”にしたいのですが 何度も申し訳ございませんがご教授お願いします。 （狭山） 2017/08/06(日) 21:18 ---- 1) こちらで試してください Sub test() Dim cn As Object, rs As Object, myDir As String, fn As String Dim n As Long, i As Long, flg As Boolean With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then myDir = .SelectedItems(1) & "¥" End With If myDir = "" Then Exit Sub Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") n = 2 fn = Dir(myDir & "*.xls") Do While fn <> "" With cn .Provider = "Microsoft.ACE.OLEDB.12.0" .Properties("Extended Properties") = "Excel 12.0" .Open myDir & fn .cursorlocation = 3 End With rs.Open "SELECT * FROM [Sheet1$]", cn, 3 If Not flg Then For i = 0 To rs.Fields.Count - 1 Cells(1, i + 1).Value = rs.Fields(i).Name Next End If Cells(n, 1).CopyFromRecordset rs n = n + rs.RecordCount rs.Close: cn.Close: flg = True fn = Dir Loop Set cn = Nothing: Set rs = Nothing End Sub 2) Array("=IFERROR(VLOOKUP(A2,リスト!$A:$B,2,FALSE),""該当無し"")","=IFERROR(VLOOKUP(A2,リスト!$A:$B,2,FALSE),""該当無し"")") かな? （ seiya） 2017/08/06(日) 22:20 ---- 有難うございます。 1) を試してみましたが rs.Open "SELECT * FROM [Sheet1$]", cn, 3が黄色くなってしまいまして 2) はCSVの方のマクロで試したところ完璧です。 Array("=IFERROR(VLOOKUP(A2,リスト!$A:$B,2,FALSE),""該当無し"")","=IFERROR(VLOOKUP(E2,リスト!$A:$B,2,FALSE),""該当無し"")") 後の方はA2ではなくE2でした。 ご教授お願いいたします。 （狭山） 2017/08/06(日) 22:49 ---- シート名はSheet1で間違いありませんか? PCは落としましたので明日また... （seiya） 2017/08/06(日) 23:18 ---- おはようございます。 大変申し訳ございません。 同じCSVデータを開き 名前を付けて保存、形式をエクセルにしただけでしたので 今回のエラーが出てしまいました。 CSVを開きコピー新たなファイルへ貼り付けを行いテストを行った結果 出来ました。 大変お騒がせ致しまして申し訳ございません。 （seiya）さん 最後まで本当にありがとうございました。 機会がございましたら、よろしくお願い致します。 米今日から早速に使用して見ます。 （狭山） 2017/08/07(月) 07:13 ---- 狭山さんはじめまして、以前、自分も地区ごとに出力される仕様に悩まされていました。 ですがこのサイトの http://www.excel.studio-kazu.jp/kw/20061229180453.htmlの SHIOJIIさん のコードと 「よねさんのWordとExcelの小部屋」さんの http://www.eurus.dti.ne.jp/‾yoneyama/Excel/vba/vba_data_matome.htmlの コードを組み合わせれば、 『フォルダーの中にあるCSVファイルのシートデータをコピー』 は可能だと思います。実際私も使ってます。大変便利です。 アレ、既にseiyaさんのコードで解決済ですね。 失礼しました。 （arakurikaessiki） 2017/08/07(月) 18:25... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201708/20170805222537.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97049 documents and 608241 words.
訪問者：