Excel VBA質問箱 IV

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

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


2437 / 13645 ツリー ←次へ | 前へ→

【68025】CSVデータの検索について あき 11/1/26(水) 11:35 質問[未読]
【68026】Re:CSVデータの検索について SK63 11/1/26(水) 12:53 発言[未読]
【68027】Re:CSVデータの検索について Jaka 11/1/26(水) 12:56 発言[未読]
【68029】Re:CSVデータの検索について あき 11/1/26(水) 14:08 質問[未読]
【68031】Re:CSVデータの検索について Jaka 11/1/26(水) 14:55 発言[未読]
【68035】Re:CSVデータの検索について SK63 11/1/26(水) 15:24 発言[未読]
【68033】Re:CSVデータの検索について kanabun 11/1/26(水) 15:13 発言[未読]
【68036】Re:CSVデータの検索について あき 11/1/26(水) 17:19 お礼[未読]

【68025】CSVデータの検索について
質問  あき  - 11/1/26(水) 11:35 -

引用なし
パスワード
   はじめまして
同フォルダ上にdata.csvというファイルはありまして
A,B,C,
名前,住所,年齢

といった形のデータがあります
Sub データ読み込み()
  Dim Name     As String    
  Dim Address   As String 
  Dim Age       As String       
  Dim strInFileName As String     
  
  strInFileName = ThisWorkbook.Path & "\data.csv"
  'ファイルの存在チェック
  If Dir(strInFileName) = "" Then
    MsgBox strInFileName & "が見つかりません"
    Exit Sub
  End If

  Name = InputBox(Prompt:="名前Lを入力してください" )
  Address = InputBox(Prompt:="住所を入力してください")
  Age = InputBox(Prompt:="年齢を入力してください" )

  Open strInFileName For Append As #1      
  Print #1, Name, Address              
  Close #1                  
                
End Sub
というマクロでNameとAddress入力時にそれぞれdata.csvのデータ内容を検索し重複が無い場合はdata.csvに書き込み重複データがあった場合は警告メッセージを出し、もう一度入力させたいです。
補足:NameとAddressの入力毎にata.csvのデータ内容を検索するようにさせたい
よろしくお願い致します。

【68026】Re:CSVデータの検索について
発言  SK63  - 11/1/26(水) 12:53 -

引用なし
パスワード
   ▼あき さん:
>はじめまして
>というマクロでNameとAddress入力時にそれぞれdata.csvのデータ内容を検索し重複が無い場合はdata.csvに書き込み重複データがあった場合は警告メッセージを出し、もう一度入力させたいです。
>補足:NameとAddressの入力毎にata.csvのデータ内容を検索するようにさせたい
>よろしくお願い致します。
データの量によりますが、
配列に入れて比較する
data.csvに保存したら並べ替えでソートしておくと便利です。
参考に配列に格納する方法ですが、他にも
Z = WBK3.Sheets(1).Cells(i, 4).Resize(1, 11).Valueのような
範囲を決めてする方法もあります。

配列IDはPUBLICで宣言して下さい。


' 参照設定:Microsoft Scripting Runtime
Sub READ_File()
  Dim mypath As String
  Dim cnsFILENAME As String
  mypath = ThisWorkbook.Path
  cnsFILENAME = mypath & "\data.csv"
  Dim FSO As New FileSystemObject ' FileSystemObject
  Dim TS As TextStream      ' TextStream
  Dim strREC As String      ' 読み込んだレコード内容
  Dim GYO As Long         ' 収容するセルの行
  Dim S1 As Integer
  ' 指定ファイルをOPEN(入力モード)
  Set TS = FSO.OpenTextFile(cnsFILENAME, ForReading)
  GYO = 1
  ' ファイルのEOF(End of File)まで繰り返す
  Do Until TS.AtEndOfStream
    ' 改行までをレコードとして読み込む
    strREC = TS.ReadLine
    S1 = InStr(strREC, ",")
    ID(GYO, 1) = Mid$(strREC, 1, S1 - 1)
    ID(GYO, 2) = Mid$(strREC, S1 + 1, 20)
    GYO = GYO + 1
  Loop
  ' 指定ファイルをCLOSE
  TS.Close
  Set TS = Nothing
  Set FSO = Nothing
End Sub

【68027】Re:CSVデータの検索について
発言  Jaka  - 11/1/26(水) 12:56 -

引用なし
パスワード
   Appendで開く前に、inputで開いてLine Inputで読み込んで、突合せをしたらどうでしょうか?
ただ、名前や住所の突合せは出来ると思いますが、年齢は数字だけですよね?
同じ数字が他に無いとも限らないと思いますから、判別が難しいそうですね。
取り合えず名前だけの場合。

Dim FileNo As Long,ReadData As String
FileNo = FreeFile
Open strInFileName For Input As #FileNo
Do Until EOF(1)
  Line Input #FileNo, ReadData
  If InStr(1, ReadData, Name_1) > 0 Then
   重複Flg = True
  End if
Loop
Close #FileNo

If 重複Flg = True Then
  msgbox "あり"
else
  AppendOpenして追加。
end If

変数名にNameとAddressは止めた方がいいですね。

【68029】Re:CSVデータの検索について
質問  あき  - 11/1/26(水) 14:08 -

引用なし
パスワード
   SK63さんJakaさんありがとうございます。
SK63さんすみません
>Dim FSO As New FileSystemObject
なのですが、「コンパイルエラー」と表示され「ユーザ定義型は定義されていません」というエラーがでます。
Excel2003では使えない変数なのでしょうか?
Jakaさん
> If InStr(1, ReadData, Name_1) > 0 Then
>   重複Flg = True
のName_1と重複Flg は変数が定義されていないというエラーになります?
重複FlgはそのままDim As Stringなどで変数を宣言すればいいのでしょうか?
Name_1の変数の定義はどのようにすればいいのでしょうか?
色々お聞きして申し訳ありませんがよろしくお願いします。

【68031】Re:CSVデータの検索について
発言  Jaka  - 11/1/26(水) 14:55 -

引用なし
パスワード
   ▼あき さん:
>>Dim FSO As New FileSystemObject
>なのですが、「コンパイルエラー」と表示され「ユーザ定義型は定義されていません」というエラーがでます。
>Excel2003では使えない変数なのでしょうか?

これは、
>' 参照設定:Microsoft Scripting Runtime
これをやっていないからですね。
参照設定は、VBE画面にて
ツール → 参照設定
を開いて、Microsoft Scripting Runtime と書かれている項目にチェック。


>> If InStr(1, ReadData, Name_1) > 0 Then
>>   重複Flg = True
>のName_1と重複Flg は変数が定義されていないというエラーになります?

ツール → オプション → 編集タブ
にて、「変数の宣言を強制する」チェックが入っていると、
Dim aaa
とか、変数を宣言しない時に出るエラーです。
モジュール1番上に「Option Explicit」とかかれた物が変数の宣言を強制する目印。
Dim 重複Flg As Boolean
てかけば、変数 重複Flgについてはエラーは出なくなります。

>重複FlgはそのままDim As Stringなどで変数を宣言すればいいのでしょうか?
>Name_1の変数の定義はどのようにすればいいのでしょうか?

これは、

>Dim Name     As String
   ↑
こういう風に予約語を変数名に使うのは止めた方がいいと言っているだけで、
好きな型でいいと思うけど、文字列だから同じくString型を使うと思います。

【68033】Re:CSVデータの検索について
発言  kanabun  - 11/1/26(水) 15:13 -

引用なし
パスワード
   ▼あき さん:   こんにちは〜

>マクロでNameとAddress入力時にそれぞれdata.csvのデータ内容を検索し重複が無い場合はdata.csvに書き込み重複データがあった場合は警告メッセージを出し、もう一度入力させたいです。

こんにちは〜
別案で、ユーザーフォームでデータ入力する案です。
以下の手順で、標準モジュールとUserForm1を作成しておくと、
CSVファイルの更新、新規追加が行えます。

標準モジュールに 以下のユーザーフォームを開くコードを
書いておきます。
'--------------------------------- 標準モジュール
Public myFILENAME As String

Sub CSV読み込み()
 
  myFILENAME = ThisWorkbook.Path & "\data.csv"
  'ファイルの存在チェック
  If Len(Dir$(myFILENAME)) = 0 Then
    MsgBox myFILENAME & "が見つかりません"
    Exit Sub
  End If
     
  UserForm1.Show 0
  
End Sub

UserFormを挿入し、
 ListBox1
 Label1,Label2,Label3
 TextBox1(名前用), TextBox2(住所用), TextBox3(年齢用)
 CommandButton1(新規) , CommandButton2(更新保存) を
概ね以下のように フォームに貼り付けます。

   ┏━━━━━━━━━━━━━━━━━┓
   ┃                 ┃
   ┃                 ┃
   ┃                 ┃
   ┗━━━━━━━━━━━━━━━━━┛
   Label1  【TextBox1   】
   Label2  【TextBox2   】 【CommandButton1】
   Label3  【TextBox3   】 【CommandButton2】

コードは以下のようです。
'-------------------------------------------- UserForm1
Option Explicit

Private dic As Object
Private ActiveRow As Long
Private NoUpdate As Boolean

Private Sub UserForm_Initialize()
  Label1.Caption = "名前"
  Label2.Caption = "住所"
  Label3.Caption = "年齢"
  CommandButton1.Caption = "新規(new)"
  CommandButton2.Caption = "更新(Save)"
  Set dic = CreateObject("Scripting.Dictionary")
  
  Dim io As Integer
  Dim buf() As Byte
  io = FreeFile()
  Open myFILENAME For Binary As io
   ReDim buf(1 To LOF(io))
   Get io, , buf
  Close io
  Dim v, vv(), t
  Dim i As Long, j As Long
  v = Split(StrConv(buf, vbUnicode), vbCrLf)
  ReDim vv(0 To UBound(v) - 1, 2)
  For i = 0 To UBound(v) - 1
    t = Split(v(i), ",")
    vv(i, 0) = t(0)
    If UBound(t) > 0 Then
      vv(i, 1) = t(1)
      If UBound(t) > 1 Then vv(i, 2) = t(2)
    End If
    dic(t(0)) = i
  Next
  ListBox1.ColumnCount = 3
  ListBox1.List = vv
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, _
                CloseMode As Integer)
  If MsgBox("更新を保存しますか?", vbOKCancel) = vbOK Then
    Dim io As Integer
    Dim v, i As Long
    io = FreeFile()
    Open myFILENAME For Output As io
    With ListBox1
      For i = 0 To .ListCount - 1
        Print #io, Join(Array( _
         .List(i, 0), .List(i, 1), .List(i, 2)), ",")
      Next
    End With
    Close io
    MsgBox "保存しました", , myFILENAME
  End If
  Set dic = Nothing
End Sub

Private Sub ListBox1_Click()
  If NoUpdate Then Exit Sub
  
  Dim i As Long
  With ListBox1
    i = .ListIndex
    If i < 0 Then Exit Sub
    ActiveRow = i
    TextBox1.Text = .List(i, 0)
    TextBox2.Text = .List(i, 1)
    TextBox3.Text = .List(i, 2)
  End With
End Sub

'【TextBox1】で新規名前が入力されたとき
Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
  If ActiveRow = -1 Then
    If dic.Exists(TextBox1.Text) Then
      MsgBox "この名前はすでに" _
        & dic(TextBox1.Text) & _
        "登録されています"
      Cancel.Value = True
    End If
  End If
End Sub

'【新規】ボタンが押されたときの処理
Private Sub CommandButton1_Click()
  ActiveRow = -1 'Listにないフラグ
  TextBox1.Text = vbNullString
  TextBox2.Text = vbNullString
  TextBox3.Text = vbNullString
End Sub

'【更新】ボタンが押されたときの処理
Private Sub CommandButton2_Click()
  Dim strName As String
  strName = TextBox1.Text
  If Len(strName) = 0 Then
    MsgBox "名前が入力されていません"
    Exit Sub
  ElseIf ActiveRow = -1 Then
    If dic.Exists(strName) Then
      MsgBox "この名前はすでに登録されています"
      Exit Sub
    End If
    ActiveRow = dic.Count
    dic(strName) = ActiveRow
    With ListBox1
      .AddItem strName
      .List(ActiveRow, 1) = TextBox2.Text
      .List(ActiveRow, 2) = TextBox3.Text
    End With
      
  Else
    NoUpdate = True
    With ListBox1
      .List(ActiveRow, 0) = strName
      .List(ActiveRow, 1) = TextBox2.Text
      .List(ActiveRow, 2) = TextBox3.Text
    End With
    NoUpdate = False
  End If
End Sub
------------------------------------------- ここまで


最後に、マクロBookのシートに フォームコントロールまたは
図形でボタンを置いて、そのボタンに 上の「CSV読み込み」を
マクロ登録しておきます。

シートのマクロ登録したボタンをクリックすると、
data.csvがListBox1に読み込まれますから、
既存データを修正するばあいはそのリストをClickして【更新】
ボタンを押し、
新規入力のときは【新規】ボタンを押してから、データをTextBoxに
入力後、【更新】ボタンを押します。

【68035】Re:CSVデータの検索について
発言  SK63  - 11/1/26(水) 15:24 -

引用なし
パスワード
   ▼あき さん:
>SK63さんJakaさんありがとうございます。
>SK63さんすみません
>>Dim FSO As New FileSystemObject
>なのですが、「コンパイルエラー」と表示され「ユーザ定義型は定義されていません」というエラーがでます。
>Excel2003では使えない変数なのでしょうか?

マクロのツールからMicrosoft Scripting Runtimeを
選択しておいて下さい、この辺りは普通に良く使用しますのですね、


'  [参照設定]
'  ・Microsoft Scripting Runtime

ソートのマクロはこんな感じです、

WBK3.Sheets(1).Columns("B:B").Select
WBK3.Sheets(1).Range("A1:F" & GYO).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    SortMethod:=xlPinYin, DataOption1:=xlSortNormal

ファイルを開いて最後の行まで配列に取り込むコード(ファイル名は合わせて下さい)
Public GYO As Integer
Public Z As Variant
Public WBK1 As Workbook, WBK2 As Workbook, WBK3 As Workbook     
Public SH1 As Worksheet, SH2 As Worksheet, SH3 As Worksheet

TargetFile = ThisWorkbook.Path & "\" & Year(strday) & "DB業務報告.csv"
Workbooks.Open Filename:=TargetFile
Set WBK3 = ActiveWorkbook  ' 現在ブック
GYO = WBK3.Sheets(1).Range("$A$65536").End(xlUp).Row
Z = WBK3.Sheets(1).Cells(1, 1).Resize(gyo, 3).Value'A~Cまで

【68036】Re:CSVデータの検索について
お礼  あき  - 11/1/26(水) 17:19 -

引用なし
パスワード
   Jakaさん、SK63さん丁寧に説明頂きありがとうございます。
ご指摘頂いた変数名はn_dataに変更しておきました。Jakaさんのコードを使わせて頂きうまくいきました。
kanabunさん別案ありがとうございます。
私のレベルでは少し難しいようなのでもう少し勉強して今後の参考にさせていただこうと思います。皆さん迅速なレス真にありがとうございました。

2437 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free