Ｐａｇｅ 741 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼レコードの修正について EBA 03/2/13(木) 18:39 ┣Re:レコードの修正について Hirofumi 03/2/13(木) 20:51 ┃ ┗Re:レコードの修正について Hirofumi 03/2/13(木) 21:36 ┃ ┗Re:レコードの修正について EBA 03/2/14(金) 11:31 ┗Re:レコードの修正について Jaka 03/2/14(金) 10:09 ┗Re:レコードの修正について EBA 03/2/14(金) 11:26 ─────────────────────────────────────── ■題名 ： レコードの修正について ■名前 ： EBA ■日付 ： 03/2/13(木) 18:39 -------------------------------------------------------------------------
| またまたお世話になります。 ＥＸＣＥＬＶＢＡ初心者のＥＢＡです。 早速質問なのですが Ａ Ｂ Ｃ Ｄ ・ ・ ・ １ Ｎｏ 氏名 住所 電話番号 ・ ・ ・ ２ 1 相川憲子 水戸市泉町 029-AAA-BBBB ・ ・ ・ ３ 2 伊東芳美 水戸市常磐町 029-CCC-DDDD ・ ・ ・ ４ 3 歌田光子 水戸市南町 029-EEE-FFFF ・ ・ ・ ５ 4 遠藤桜子 水戸市堀町 029-GGG-HHHH ・ ・ ・ ６ 5 及川恵 水戸市千波町 029-III-JJJJ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ というシートがあったとします。 テキストボックス１（No）、テキストボックス２（氏名）、テキストボックス３（住所）、 テキストボックス４（電話番号）が表示されているユーザーフォームがあります。 コマンドボタンが何個かあって、レコード移動ボタン等だとします。 その中の１つがコマンドボタン１（修正）だとします。 データを修正したい場合、ユーザーフォームに表示させて、コマンドボタン１をクリック することによって、テキストボックス１のNoと一致したＡ列のNoのレコードを書き換える ということをやりたいのです。 フクザツなジジョウがありまして、ControlSourceでリンクで直接というわけにはいかず・・・。 まずNoが一致するセルをセレクトして、それからオフセットで書き換えという感じだと思 うのですが？違うかな・・・(-_-;) どなたかご教授お願いします。 |
| UserFormを作って見ました Noに抜け番が無ければNoとセルの行の値を関連付ければ簡単だと思いますが 一応Noに抜けが有る物として考えて見ました 尚、Noは昇順に並んでいることが条件です 探索の開始は、コマンドボタンで探すのでは無くTextBox1のExitイベントで番号を探します また、修正だけと言う事ですが、TextBox1の無い番号を入れた場合、新規入力に成り 例えば、10番、12番が存在する時、11番を指定すると10番、12番の間に行が挿入され11番が書きこまれます UserFormの配置は、 TextBox1〜4 CommandButton1 入力（UserFormからセルに書き込み） CommandButton2 削除（現在表示されている番号の行を削除） CommandButton3 ↑移動 CommandButton4 ↓移動 を想定しています 以下のコードをUserFormモジュールに記述 Option Explicit Private lngListTop As Long Private lngListEnd As Long Private lngCurrent As Long Private lngFind As Long Private Sub CommandButton1_Click() Dim i As Long If lngCurrent = -1 Then Exit Sub End If If lngFind <> -1 Then SetData lngCurrent Else If lngCurrent <= lngListEnd Then Cells(lngCurrent, 1).EntireRow.Insert End If SetData lngCurrent lngListEnd = lngListEnd + 1 End If ControlsInitialize With TextBox1 .Text = "" .SetFocus End With End Sub Private Sub CommandButton2_Click() Dim i As Long If lngFind <> -1 And lngCurrent <> -1 Then Beep If MsgBox("Key " & TextBox1.Text & " のDataを削除します", _ vbExclamation + vbOKCancel, "削除") = vbOK Then Rows(lngCurrent).Delete lngListEnd = lngListEnd - 1 ControlsInitialize TextBox1.Text = "" End If End If End Sub Private Sub CommandButton3_Click() lngCurrent = lngCurrent - 1 If lngCurrent < lngListTop Then lngCurrent = lngListTop End If lngFind = lngCurrent GetData lngCurrent CommandButton1.SetFocus End Sub Private Sub CommandButton4_Click() lngCurrent = lngCurrent + 1 If lngCurrent < lngListTop Or lngCurrent > lngListEnd Then lngCurrent = lngListEnd End If lngFind = lngCurrent GetData lngCurrent CommandButton1.SetFocus End Sub Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim lngOver As Long Dim vntKey As Variant Dim rngIndex As Range With TextBox1 If .Text <> "" Then lngFind = -1 lngOver = lngListEnd + 1 If lngListTop <= lngListEnd Then Set rngIndex = Range(Cells(lngListTop, 1), _ Cells(lngListEnd, 1)) vntKey = CLng(.Text) lngFind = BinSearchCells(vntKey, rngIndex, , lngOver) Set rngIndex = Nothing End If If lngFind <> -1 Then lngCurrent = lngFind GetData lngCurrent Else ControlsInitialize Beep If MsgBox("該当するレコードが有りません作成します", _ vbExclamation + vbOKCancel, "新規入力") = vbOK Then lngCurrent = lngOver CommandButton1.Enabled = True Else TextBox1.Text = "" Cancel = True End If End If End If End With End Sub Private Sub UserForm_Initialize() lngListTop = 2 lngListEnd = Cells(65536, 1).End(xlUp).Row If lngListTop > lngListEnd Then lngListEnd = lngListTop - 1 Else If Cells(lngListEnd, 1).Value = "" Then lngListEnd = lngListEnd - 1 End If End If ControlsInitialize TextBox1.Text = "" End Sub Private Sub ControlsInitialize() Dim i As Long For i = 2 To 4 Me.Controls("TextBox" & i).Text = "" Next i CommandButton1.Enabled = False CommandButton2.Enabled = False lngCurrent = -1 lngFind = -1 End Sub Private Sub GetData(lngRow As Long) Dim i As Long With Cells(lngRow, 1) .Activate For i = 1 To 4 Me.Controls("TextBox" & i).Text _ = .Offset(0, i - 1).Value Next i End With CommandButton1.Enabled = True CommandButton2.Enabled = True End Sub Private Sub SetData(lngRow As Long) Dim i As Long With Cells(lngRow, 1) .Activate For i = 1 To 4 .Offset(0, i - 1).Value _ = Me.Controls("TextBox" & i).Text Next i End With End Sub 以下のコードを標準モジュールに記述 Option Explicit Option Compare Text Public Function BinSearchCells(vntKey As Variant, _ rngScope As Range, _ Optional lngUnder As Long = -1, _ Optional lngOver As Long = -1) As Long ' 二進探索セル版 Dim lngLow As Long Dim lngHigh As Long Dim lngMiddle As Long Dim vntTmp As Variant Dim lngStartAdd As Long With rngScope lngStartAdd = .Row - 1 lngLow = 1 lngHigh = .Rows.Count Do While lngLow <= lngHigh lngMiddle = (lngLow + lngHigh) \ 2 vntTmp = .Cells(lngMiddle).Value Select Case vntKey Case Is > vntTmp lngLow = lngMiddle + 1 Case Is < vntTmp lngHigh = lngMiddle - 1 Case Is = vntTmp lngLow = lngMiddle + 1 lngHigh = lngMiddle - 1 End Select Loop End With If lngLow = lngHigh + 2 Then BinSearchCells = lngStartAdd + lngMiddle Else BinSearchCells = -1 End If lngUnder = lngStartAdd + lngHigh lngOver = lngStartAdd + lngLow End Function |
| 書き忘れた事が有りました 1、このUserFormはアクティブシートがレコードが有るシートで そこで表示する事を想定しています（書き込み、読み込み共にアクティブシートから） もし、アクティブシート以外で表示する場合、GetData、SetDataプロシージャの With Cells(lngRow, 1)の部分で、With WorkSheets("Sheet1").Cells(lngRow, 1) の様に明確にシートを指定して下さい 2、リストは列見出しが第1行目に有る物と想定しています もし、リストが他の行から始まるなら Sub UserForm_Initialize() の中の lngListTop = 2と有る所を変更して下さい lngListTopはデータの先頭行を示しています 3、急いで作った為、コメントが入れて有りませんのでゴメンナサイ 肝心な部分の簡単な説明をして置きます Function BinSearchCells は、引数vntKeyに探索Keyを、 引数rngScopeに探索範囲を指定すると、戻り値として探索Keyに一致した行を返します また、一致する物が無い場合「-1」を返します 引数lngUnderは、一致する、しないに関わらず探索Keyを超えない最大値が有る行を 返しますし、引数lngOverは同様に、探索Keyを超える最小値が有る行を返します 以上、もし解らない所が有れば即答は出来ませんが（昼間見ていないので）成るべく答える様にします |
| ▼Hirofumi さん： 親切な御指導ありがとうございました。 大変勉強になるコードで参考になりました。 頑張って勉強していこうと思いますので、これからも宜しくお願い致します。 m(__)m |
| こんにちは。 [#3489]の続きみたいのものだと考えてみると、 あのコードにCommandButton7を作って、下記コードを追加するだけで良いと思うんですけど．．。 こう言うことではなく、Noを手入力したいって事だったのでしょうか？？ >ControlSourceでリンクで直接というわけにはいかず・・・。 下のように書いておけば簡単だと思いますけど。 Private Sub CommandButton7_Click() Dim strRang As String strRang = "A" & Current Range(strRang).Value = TextBox1.Value strRang = "B" & Current Range(strRang).Value = TextBox2.Value strRang = "C" & Current Range(strRang).Value = TextBox3.Value End Sub |
| ▼Jaka さん： >[#3489]の続きみたいのものだと考えてみると、 その通りでございます。 ありがとうございました。 これで本当に完成だと思います。 いつも親切な御指導ありがとうございます。 感謝、感謝でございます。m(__)m |