[[20020713170029]]　『あるシートの情報をテーブルに反映させる？』（キーマン）　ページの最後に飛ぶ

『あるシートの情報をテーブルに反映させる？』（キーマン）

『シート１に管理コードを付けた顧客リストを作り別シートにＶＬＯＯＫＵＰを用いた表を作成。管理コードを入力すると必要なデータ部分を表示させる表を作成している。

別シートに書き込んだ情報を顧客リストのデーターベースに反映させる方法を教えてください。

　　キーマンです。

 みやほりんが 未解決ログ解消を目的に 2008/02/06 16:30 ごろ、投稿しました。
 トピ主の[キーマン]さんの投稿は2002/07/13 17:00:29でした。
　
まず、仮定として、次のような構成であると解釈します。
・「シート１」　管理コードが先頭列にある顧客リスト　兼　データベース
・「別シート」　管理コード入力によってデータベース情報を表示するシート
・「別シート」はVLOOKUP関数によってシート１の内容を検索・参照している。
　
要望は次のことであると解釈します。
・「別シート」で「シート１」から顧客情報を検索表示したデータに対する関
　連情報を「シート１｣へ転記する。
　
転記処理にはマクロが必須になりますが、次の点が不明。
・「別シート」で「管理コードを入力すると必要なデータ部分を表示」する部分と、
　「データーベースに反映させる」「別シートに書き込んだ情報」に同一のものが
　あるかどうか。
　
VLOOKUP関数で検索・参照した情報を編集（上書）して新たな情報として「シート
１」に書き戻す、という動作を想定しているなら、検索・参照に用いている関数
が上書きされて消えてしまう。
この場合、マクロでいくつかの動作が考えられる。
（１）VLOOKUP関数を埋め込まずに最初からマクロで全ての情報を呼び出す仕様。
（２）上書しても良いようにマクロでVLOOKUP関数を入力しなおす仕様。
（３）VLOOKUP関数が入力されている以外のセルでデータベースに上書する為の
　　　データ編集を行う仕様。
　
とりあえず、（１）を想定。
「別シート」のシート見出しを右クリック、「コードの表示」を選択して
コードウィンドウへ下記を貼り付けます。
　
 Option Explicit
 Private Sub Worksheet_Change(ByVal target As Range)
     Rem A2セルの入力でデータベースから情報を検索・転記するコード
     Rem 転記先はこのコードを登録したシートのA2:C2を想定。
     Dim MyRng As Range, flag As Boolean
     If target.Row <> 2 Then Exit Sub
     If target.Count > 1 Then Exit Sub
     If target.Value = "" Then Exit Sub
     If target.Column = 1 Then
         flag = WorksheetFunction.CountIf(Worksheets("Sheet1").Range("A:A"), target.Value) = 1
         If flag Then
             Set MyRng = Worksheets("Sheet1").Range("A:A").Find(target.Value)
             target.Offset(0, 1).Resize(1, 2).Value = MyRng.Offset(0, 1).Resize(1, 2).Value
         Else
             MsgBox "新規データです"
             target.Offset(0, 1).Resize(1, 2).ClearContents
         End If
     End If
     Set MyRng = Nothing
 End Sub

 Private Sub CommandButton1_Click()
     Rem CommandButton1をクリックして編集したデータを
     Rem データベースに書き戻すコード
     Dim MyRng As Range, TgtRng As Range, flag As Boolean, MyAns As Variant
     Set TgtRng = Me.Range("A2:C2")
     flag = WorksheetFunction.CountIf(Worksheets("Sheet1").Range("A:A"), Me.Range("A2").Value) = 1
     If flag Then
         MyAns = MsgBox("既存データを上書しますか？", vbYesNo)
         If MyAns = vbYes Then
             Set MyRng = Worksheets("Sheet1").Range("A:A").Find(TgtRng.Value)
             MyRng.Resize(1, 3).Value = TgtRng.Value
             Application.EnableEvents = False
             TgtRng.ClearContents
             Application.EnableEvents = True
         End If
     Else
         MyAns = MsgBox("新規データを追加しますか？", vbYesNo)
         If MyAns = vbYes Then
             With Worksheets("Sheet1")
                 Set MyRng = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
             End With
             MyRng.Resize(1, 3).Value = TgtRng.Value
             Application.EnableEvents = False
             TgtRng.ClearContents
             Application.EnableEvents = True
         End If
     End If
     Set MyRng = Nothing
     Set TgtRng = Nothing
 End Sub
　
(みやほりん)(-_∂)b

コメント返信：

[ 一覧(最新更新順) ]

[[20020713170029]] 『あるシートの情報をテーブルに反映させる？』（キーマン） ページの最後に飛ぶ

[[20020713170029]]　『あるシートの情報をテーブルに反映させる？』（キーマン）　ページの最後に飛ぶ