| |
▼あき さん： こんにちは〜
>マクロで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に
入力後、【更新】ボタンを押します。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
