Excel VBA質問箱 IV

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

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


14204 / 76738 ←次へ | 前へ→

【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に
入力後、【更新】ボタンを押します。

1 hits

【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 お礼

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