いつも参考にさせて頂いております。
とても初歩的な質問ですが教えていただけないでしょうか?

Accessに人物名簿のデータベースがあります。
人物をある条件で検索し、検索にヒットした人物の情報を名簿.csvへ書き出すという作業をVBAで行いました。
検索をかける度に名簿.csvの内容は更新されます。

ここからなのですが、
Excelに下のような名簿のシートを作成しました。(名簿.xls)

―――――――――――――――――――――――――
   氏名:
 生年月日:        住所:
  Tell:         Fax:
  会社名:   会社Tell:   会社Fax:

―――――――――――――――――――――――――
(実際にはもっと沢山の項目があり、レイアウトも複雑ですが、簡略しています。)
名簿.xlsを開いた時、もしくは名簿.csvを更新した時点で名簿.xlsに名簿.csvの内容を書き込みたいのですが、
(1)検索にヒットした人物が複数いる事がほとんどなので、このシートを人数分コピーしたい。
(2)そもそもどうすればこのシートにCSVファイルの内容を書き込めるのでしょうか?

よろしくご教授の程、お願い致します。

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

A 回答 (2件)

シート1枚のものを原本として使って下さい。


そのシート名は名簿001としています。(モジュールの内容と対応していれば当然、別の名前でもいいです)

CSV_file_Readを実行すれば、CSVファイルを選択するダイアログが出ます。対象ファイルを選択します。

込み入ったことをすると長くなるのでmyPotをmyPot(CSVファイルの項目順,行または列番号)の意味に使っています。
myPot(0, 0) = 1: myPot(0, 1) = 2 は最初の項目は行=1、列=2(B1になります)を表します。実情に合うように変えてください。これは項目名が多い場合は、別シートに入力位置の行・列番号テーブルを作っておいて読み込むようにしたら簡単になると思います。
想定は例えば、項目名『氏名:』はA1で、氏名をB1に書き込むようにしています。

標準モジュールに貼り付けます。Excel2000です。97でしたら補足して下さい。修正します。
Public Sub CSV_file_Read()
 Dim myPot(7, 1) As Variant 'シート上の座標
 Dim dtNum As Integer '項目数(0から)
 Dim cot As Integer 'カウンタ
  dtNum = 7
  myPot(0, 0) = 1: myPot(0, 1) = 2 '入力セルの座標をセットする
  myPot(1, 0) = 2: myPot(1, 1) = 2 '読み込めば速いけど・・・
  myPot(2, 0) = 2: myPot(2, 1) = 4
  myPot(3, 0) = 3: myPot(3, 1) = 2
  myPot(4, 0) = 3: myPot(4, 1) = 4
  myPot(5, 0) = 4: myPot(5, 1) = 2
  myPot(6, 0) = 4: myPot(6, 1) = 4
  myPot(7, 0) = 4: myPot(7, 1) = 6

 Dim CSVfilename As Variant 'CSVファイル名
 Dim dat As String 'CSVデータ
 Dim myArray As Variant 'CSVデータを配列化
 Dim ShtNum As Integer 'シート数

 CSVfilename = Application.GetOpenFilename("CSVファイル (*.csv), *.csv")
  If CSVfilename = False Then 'CSVファイルを選択
   Exit Sub
  End If

 Application.ScreenUpdating = False
 ShtNum = 0
 Open CSVfilename For Input As #1
 'Line Input #1, dat 'CSVファイルに項目名があれば『'』を削除すれば読み飛ばしになる
 While Not EOF(1)
  Line Input #1, dat '1シート分のデータを読む
  ShtNum = ShtNum + 1
  If ShtNum > 1 Then 'シートを追加
   Worksheets("名簿001").Copy after:=Worksheets("名簿" & Right("00" & (ShtNum - 1), 3))
   ActiveSheet.Name = "名簿" & Right("00" & ShtNum, 3)
  End If

  myArray = Split(dat, ",")
  For cot = 0 To dtNum 'シートに展開
   ActiveSheet.Cells(myPot(cot, 0), myPot(cot, 1)) = myArray(cot)
  Next
 Wend
 Close #1

 Worksheets("名簿001").Activate
 Application.ScreenUpdating = True
End Sub

この回答への補足

myPotの意味わかりました~。
おかげさまでできました。本当にありがとうございました。

補足日時:2001/07/26 17:30
    • good
    • 0
この回答へのお礼

コピペでWorkbook_Open()に貼り付けたらできました。まさに望んでいた処理です。
名簿.csvは検索をかける度に更新されるものですから、ダイアログでcsvファイルを指定するのでなく常に名簿.csvを開く様に処理を書き換えました。勝手にいじって申し訳ないです。
プログラム処理的には申し分ないのですが、どうやら私の理解力に申す所があるようでして、myPotの意味がよくわからず特定のセルに特定のデータを貼り付けられない・・・。(滝汗
もちろん自力で理解しようと最大限の努力は致しますが、myPotの解釈についての解説をお願いできないでしょうか?

お礼日時:2001/07/26 11:09

どもども田吾作7です。



質問です。
CSVには項目のヘッダが入っていますか?

この回答への補足

項目のヘッダ・・・・Accessテーブルで言うフィールド名の事でしょうか?
入っていないです。私の希望する処理に無ければならないものでしたら、併せて御教授いただけないでしょうか?

補足日時:2001/07/25 23:59
    • good
    • 0

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

CSV 意味」に関するQ&A: VBとVBAの違い

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

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

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

QXL2003:別ブックを検索してデータを拾った後、ヒットしなかったものも別途拾う方法

あるシートにあるデータを別のシートにまとめようとしています。
具体的には、元シートの電話番号をキーに差分シートの電話番号を検索し、ヒットした行の各データを元シートの所定の行に転記するというものです。
元シート・差分シートともに構成は同じです。元シートのC列以外は歯抜けがあることがありますが、キーとなるC列には歯抜けが無く、この列の最後尾をテーブルのEndとして利用することが可能です。

元シート:
C列→ユーザ名
E列→電話番号
G列→項目1
H列→項目2

差分シート:
C列→ユーザ名
E列→電話番号
G列→項目1
H列→項目2

要するにVLOOKUPのような事を行いたいのですが、続きがありまして・・・
"差分シートにある電話番号が元シートに存在しない場合"、検索に引っかからなかったからといって無視せず、その情報もあわせて取り込みたいのです。
取り込み先の列は上記のVLOOKUPに準じます。
ダイアログを開いてファイルを選択させるまではわかるのですが、その後の手順がどうにもさっぱりで・・・

添付ファイルにやりたいことを書いてみました。どなたか手順をご教示いただけませんでしょうか。

あるシートにあるデータを別のシートにまとめようとしています。
具体的には、元シートの電話番号をキーに差分シートの電話番号を検索し、ヒットした行の各データを元シートの所定の行に転記するというものです。
元シート・差分シートともに構成は同じです。元シートのC列以外は歯抜けがあることがありますが、キーとなるC列には歯抜けが無く、この列の最後尾をテーブルのEndとして利用することが可能です。

元シート:
C列→ユーザ名
E列→電話番号
G列→項目1
H列→項目2

差分シート:
C列→ユーザ名...続きを読む

Aベストアンサー

質問には、表題に「VBAで処理したい」ことをはっきり書くこと。
(マクロ実行後を見て始めてそれが判る。VLOOKUPなど出して関数の質問かと誤解する)
ーー
添付画像は、読者・回答者がテストで使えるよう、質問の中にデータを書いておいてほしい。回答の時再入力しないといけないのは、かなわない。
ーー
この質問も、回答者に全てのコードを書いてくれという、丸投げに近いな。
ーーー
これは両データをソートして、マッチングのアルゴリズムでやる問題だが、質問者には説明を要するので、初歩的な蚊mmが得やすいやり方でやってみた。
例データ 以下ーは空白セル(画面で左詰されないようにこの回答だけに入れた)
必要最小限の項目データにしている。多数でテストしてみてください。
Sheet1
ユーザー名-電話番号
a-1
b-2
c-3
Sheet2
ユーザー名-電話番号-項目
c     -4-x
b     -2-y
d     -5-z
e     -6-w
ーー
コード ひょ順モジュールに
Sub test01()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set sh3 = Worksheets("Sheet3")
'--
d1 = sh1.Range("a65536").End(xlUp).Row
d2 = sh2.Range("a65536").End(xlUp).Row
'MsgBox d1
'MsgBox d2
k = 2
'---
For i = 2 To d1
sh3.Cells(k, "A") = sh1.Cells(i, "A")
sh3.Cells(k, "C") = sh1.Cells(i, "C")
k = k + 1
For j = 2 To d2
If sh2.Cells(j, "J") = "" Then
If sh2.Cells(j, "A") = sh1.Cells(i, "A") Then
If sh2.Cells(j, "C") = sh1.Cells(i, "C") Then
sh2.Cells(j, "J") = "Y"
Else
sh3.Cells(k, "A") = sh2.Cells(j, "A")
sh3.Cells(k, "C") = sh2.Cells(j, "C")
sh3.Cells(k, "E") = sh2.Cells(j, "E")
k = k + 1
sh2.Cells(j, "J") = "Y"
End If
Else
End If
End If
Next j
Next i
'---
For j = 2 To d2
If sh2.Cells(j, "J") = "Y" Then
Else
sh3.Cells(k, "A") = sh2.Cells(j, "A")
sh3.Cells(k, "C") = sh2.Cells(j, "C")
sh3.Cells(k, "A") = sh2.Cells(j, "A")
sh3.Cells(k, "E") = sh2.Cells(j, "E")
k = k + 1
End If
Next j
End Sub
項目の代入は、手を抜いて、最小限にしてあるので、補ってください。
ーーー
Sheet3
ユーザー名-電話番号-項目
a-1-
b-2-
c-3-
c-4-x
d-5-z
e-6-w

質問には、表題に「VBAで処理したい」ことをはっきり書くこと。
(マクロ実行後を見て始めてそれが判る。VLOOKUPなど出して関数の質問かと誤解する)
ーー
添付画像は、読者・回答者がテストで使えるよう、質問の中にデータを書いておいてほしい。回答の時再入力しないといけないのは、かなわない。
ーー
この質問も、回答者に全てのコードを書いてくれという、丸投げに近いな。
ーーー
これは両データをソートして、マッチングのアルゴリズムでやる問題だが、質問者には説明を要するので、初歩的な蚊mmが...続きを読む

QVBA : CSV、xlsファイルを内部で開いて処理したい。(Txtファイルで可能なように)

 TextファイルをPC内部で開いて書き込み、読み出しは可能ですが、同様のことをCSVファイルやエクセルファイルで出来ないでしょうか?
 実際には、例えば次のような処理をしてみたいです。
For i= 1 to 10
cells(i,1)=i
next i
というコードをPC内部でActiveになったファイルにしたいと考えています。
 宜しくお願いいたします。

Aベストアンサー

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = False
objExcel.Workbooks.Open ("c:\book1.xls")
objExcel.Sheets("Sheet1").Select
objExcel.Cells(1, 1).Value = "hello world"
objExcel.Workbooks("book1.xls").Close SaveChanges:=True

Q1フォルダに「A.xls」、「B.xls」、「C.xls」・・・とある

1フォルダに「A.xls」、「B.xls」、「C.xls」・・・とある場合、
すべてのファイルに一斉にA1セルに「a」という文字を反映させる場合の
VBAプログラムを教えていただけますでしょうか?
よろしくお願いいたします。

Aベストアンサー

フォルダ名を変更してから試してね
4行目の
mPath = "C:\tmp\"
「aaa」なら
mPath = "C:\aaa\"
に変更


Sub test()
Dim mPath As String
Dim nf As String
mPath = "C:\tmp\"
nf = Dir(mPath & ".xls")
Do While nf <> ""
Workbooks.Open Filename:=mPath & nf
Workbooks(nf).ActiveSheet.Range("a1").Value = "a"
Workbooks(nf).Close SaveChanges:=False
nf = Dir()
Loop
End Sub

簡単なコードにしてあるので、分らない所はヘルプで調べてね
参考まで

Qエクセルファイル(book)のシートの内容をCSVファイルにおとしたい

こんにちは。
VB初心者です。

実はVBではなく、Excel VBAで行なっているのですが。
ここに質問していいかもよく分かってないのですが。
プログラムの処理としては、あるBookのシートの内容を
別のCSVファイルとして生成したいのです。マクロを組んだのですが、一つ問題があって困っています。

問題:
生成したCSVファイルが一度Window上に表示されて
(それはいいのですが、あとで閉じますから)
以下の確認メッセージがでてしまいます。

「outFile.csvはExcel97のファイル形式では、ありません。変更を保存しますか?」

要はプログラムがここで、一旦ユーザアクションを要求してしまうのです。
アクションなしに普通に終了させたいのですが。

マクロではなくVBだったらこんなことはならないのでしょうか?
初心なのでよく分かりません。
もしくはもっとほかの簡単なコードできるのでしょうか。

以下にコードを記述します。

Sub OutFile()

Dim myWBpath As String

myWBpath = ActiveWorkbook.Path

Workbooks.Open FileName:=myWBpath & "\testData1.xls"
Sheets("sheet1").Select
ActiveWorkbook.SaveAs FileName:="C:\outFile.csv", _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close

End Sub

こんにちは。
VB初心者です。

実はVBではなく、Excel VBAで行なっているのですが。
ここに質問していいかもよく分かってないのですが。
プログラムの処理としては、あるBookのシートの内容を
別のCSVファイルとして生成したいのです。マクロを組んだのですが、一つ問題があって困っています。

問題:
生成したCSVファイルが一度Window上に表示されて
(それはいいのですが、あとで閉じますから)
以下の確認メッセージがでてしまいます。

「outFile.csvはExcel97のファイル形式...続きを読む

Aベストアンサー

Application.DisplayAlertsをFalseにすることでSaveAsでの警告の表示を停止することができます。

Closeでの変更保存のメッセージは、SaveChangesをFalseにすればOKです。

この修正を含めてちょっと手を入れてみました。

Sub OutFile()

Dim myWBpath As String
Dim objBook As Workbook

Err.Clear
On Error GoTo OutFile_Err

'画面の更新を停止してい処理を高速化
Application.ScreenUpdating = False

'パス名の取得
myWBpath = ActiveWorkbook.Path

If Right(myWBpath, 1) <> "\" Then
myWBpath = myWBpath & "\"
End If

'ワークブックをオープン
Set objBook = Workbooks.Open(Filename:=myWBpath & "testData1.xls")

'警告の表示を停止
Application.DisplayAlerts = False

'開いたワークブックのSheet1をCSVで保存
objBook.Worksheets("sheet1").SaveAs Filename:="C:\outFile.csv", _
FileFormat:=xlCSV, CreateBackup:=False

'開いたワークブックを閉じる
objBook.Close SaveChanges:=False

'変数の開放
Set objBook = Nothing

OutFile_Err:
'エラー発生時の処理
If Err.Number <> 0 Then
MsgBox Err.Description, vbExclamation, "エラーの報告"
End If
'警告の表示の再開
Application.DisplayAlerts = True
'画面更新の再開
Application.ScreenUpdating = True
Exit Sub
End Sub

Application.DisplayAlertsをFalseにすることでSaveAsでの警告の表示を停止することができます。

Closeでの変更保存のメッセージは、SaveChangesをFalseにすればOKです。

この修正を含めてちょっと手を入れてみました。

Sub OutFile()

Dim myWBpath As String
Dim objBook As Workbook

Err.Clear
On Error GoTo OutFile_Err

'画面の更新を停止してい処理を高速化
Application.ScreenUpdating = False

'パス名の取得
myWBpath = ActiveWorkboo...続きを読む

Q複数条件で検索・抽出し、別シートに順次保存したい

・exel 2003
過去事例を参考にvbaでやってみているのですが、
勉強しはじめの自分に荷が重いようで、相談いたします。

日付 時刻  緯度  経度 回数
0531 1731 141.4 35.6 2
0531 2027 146.6 38.7 1
0531 2343 145.5 36.4 1
・  ・   ・  ・  ・
・  ・   ・  ・  ・
上のような中身のcsvファイルがたくさん(0531.csv etc)に入っているフォルダがあります。その中のファイルをまずひとつ開き、ある条件で検索、抽出します。その後、その結果を別ブック(Book1)のシートにコピーし、csvファイルを閉じます。また残りのcsvファイルについても開いていき同様の処理を行いたいのですが、処理結果を先ほどのBook1のシートに上から順にどんどん付加していきたいと考えています。こういった処理はどのような流れで書いたらよろしいのでしょうか、具体的にお教え願えないでしょうか。

・ある条件とは上表を例にすると、緯度が141.4より大きく、146.6より小さいもの、かつ経度が35.6より大きく、38.7より小さいものといった条件です(ここでは3行目のデータが抽出されるはず)。
・配列で読み込んでsplitすればいいと思いましたが、抽出後は文字列でしか表示されない。どうにか数字で読み込ませることができないのか。
・また処理ファイルがたくさんあるため、別Bookが65536行を超えたときにどうしたらいいのかも悩んでいます。

・exel 2003
過去事例を参考にvbaでやってみているのですが、
勉強しはじめの自分に荷が重いようで、相談いたします。

日付 時刻  緯度  経度 回数
0531 1731 141.4 35.6 2
0531 2027 146.6 38.7 1
0531 2343 145.5 36.4 1
・  ・   ・  ・  ・
・  ・   ・  ・  ・
上のような中身のcsvファイルがたくさん(0531.csv etc)に入っているフォルダがあります。その中のファイルをまずひとつ開き、ある条件で検索、抽出します。その後、その結果を別ブック(Bo...続きを読む

Aベストアンサー

1ファイルが65536行より少なくて、全部で65536行を超えない場合です。
65536行を超える場合は・・・Excel2007を用意するのをお勧めします。(ただし使い勝手で苦労するかも知れませんが)
Sub sample()
Dim dataFolder As String
Dim dataSheet As Worksheet
Dim tempSheet As Worksheet
Dim workLastRow As Long
Dim dataLastRow As Long
Dim dataFile As String
Set dataSheet = Sheets("Sheet1") 'データ集計シート
dataFolder = "c:\data\" 'csvデータのあるフォルダ
Application.ScreenUpdating = False
Set tempSheet = Worksheets.Add
dataSheet.Cells.Delete
dataSheet.Range("A1:E1") = Array("日付", "時刻", "緯度", "経度", "回数")
dataFile = Dir(dataFolder & "*.csv", vbNormal)
Do While dataFile <> ""
tempSheet.Cells.Delete
With tempSheet.QueryTables.Add(Connection:="TEXT;" & dataFolder & dataFile, Destination:=tempSheet.Range("A1"))
.TextFileStartRow = 1
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True '空白区切りで無い場合はいらない
.TextFileTabDelimiter = True 'TAB区切りで無い場合はいらない
.Refresh
End With
workLastRow = tempSheet.Range("A" & Rows.Count).End(xlUp).Row
tempSheet.Range("F2:F" & workLastRow).Formula = "=IF(AND(C2>141.4,C2<146.6,D2>35.6,D2<38.7),1,0)" '検索条件(C2:緯度 D2:経度)
tempSheet.Range("A1:F" & workLastRow).AutoFilter Field:=6, Criteria1:="1"
dataLastRow = dataSheet.Range("A" & Rows.Count).End(xlUp).Row
tempSheet.Range("A2:E" & workLastRow).Copy Destination:=dataSheet.Range("A" & dataLastRow + 1)
dataFile = Dir
Loop
Application.DisplayAlerts = False
tempSheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

p.s.
csvの1行目に見出し(「日付,時刻,緯度,経度,回数」)がある場合です。(質問のデータにはあるので)
質問のデータが空白(TAB?)区切りにも見えるので、それでも分けるようにしてます。

1ファイルが65536行より少なくて、全部で65536行を超えない場合です。
65536行を超える場合は・・・Excel2007を用意するのをお勧めします。(ただし使い勝手で苦労するかも知れませんが)
Sub sample()
Dim dataFolder As String
Dim dataSheet As Worksheet
Dim tempSheet As Worksheet
Dim workLastRow As Long
Dim dataLastRow As Long
Dim dataFile As String
Set dataSheet = Sheets("Sheet1") 'データ集計シート
dataFolder = "c:\data\" 'csvデータのあるフォルダ
Application.ScreenUpdating...続きを読む


人気Q&Aランキング

おすすめ情報