エクセル顧客管理 | 第11回.顧客登録より顧客一覧へ更新 | Excelマクロを駆使したカスタマイズ可能なエクセル顧客管理、エクセルVBAの学習教材



最終更新日:2014-11-11

第11回.顧客登録より顧客一覧へ更新


エクセルで顧客管理を作ります、


プログラム完成へ向けて一気に突き進みましょう、


今回は、「顧客登録」で入力した内容を、「顧客一覧」へ更新します。


「顧客番号」が存在しない場合は、最終行の次へ、


存在する場合は、その行へ更新します。



その前に、まずSubモジュール「顧客一覧より取得」を少し修正します。


1つは、バグがありましたので、修正します。


もう1点は、存在しない番号を入力した場合のメッセージを少し変更します。


Sub 顧客一覧より取得()
  Dim r0 As Long       '行番号ワーク
  Dim r1 As Long, c1 As Long '顧客一覧の見出しの行,列位置
  Dim r2 As Long, c2 As Long '顧客登録の行,列位置
  Dim rngFind As Range    'Findの結果保存

  Call マクロ開始処理
  
  r1 = 開始セル取得("顧客一覧").Row  '顧客一覧の開始行位置を取得
  c1 = 開始セル取得("顧客一覧").Column '顧客一覧の開始列位置を取得
  r2 = 開始セル取得("顧客登録").Row  '顧客登録の開始行位置を取得
  c2 = 開始セル取得("顧客登録").Column '顧客登録の開始列位置を取得
    
  '顧客番号が未入力は処理終了
  If IsEmpty(シート取得("顧客登録").Cells(r1, c1 + 1)) Then
    Call マクロ終了処理
    Exit Sub
  End If

  With シート取得("顧客一覧")
    '顧客登録の顧客番号で、顧客一覧の顧客番号を検索
    Set rngFind = .Range(.Cells(r1 + 1, c1), .Cells(.Cells.SpecialCells(xlLastCell).Row, c1)) _
            .Find(What:=シート取得("顧客登録").Cells(r2, c2 + 1), _
            After:=.Cells(r1 + 1, c1), _
            LookIn:=xlFormulas, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            MatchByte:=False)
    If rngFind Is Nothing Then '見つからなかった場合
      MsgBox "指定の" & シート取得("顧客登録").Cells(r2, c2) & "は存在しません。" & vbLf & vbLf & _
          "新規登録となります。",
vbOKOnly
      Call マクロ終了処理
      Exit Sub
    End If
    r0 = rngFind.Row '検索された行
    Do Until IsEmpty(.Cells(r1, c1)) '顧客一覧の見出し列の終わりまで
      '顧客登録←顧客一覧
      シート取得("顧客登録").Cells(r2, c2 + 1) = .Cells(r0, c1)
      c1 = c1 + 1 '顧客一覧の列を右に
      r2 = r2 + 2 '顧客登録の行を2つ下に
    Loop
  End With

  Call マクロ終了処理
End Sub


修正箇所を太字にしています。


バグについて

r1 = rngFind.Rowとなっていましたので、

IsEmpty(.Cells(r1, c1)) において、

検索された行を使い空白セルの判定をしていました。

途中の列に未入力があると、それ以降のデータが取得されません。

そこで、新たに、変数r0を定義し、

r0 = rngFind.Row 変更としました。

そして、実際にデータ取得する行において、このr0を使用しています。

あくまで、r1は、見出し行の行番号として使うようにしています。


MsgBox "指定の" & シート取得("顧客登録").Cells(r2, c2) & "は存在しません。" & vbLf & vbLf & _
          "新規登録となります。",
vbOKOnly
メッセージを少し分かりやすく修正しました。

vbLfは、改行コードで、Chr(10)と同じです。

Chr関数は、指定したコードの文字を返します。



では新規Subモジュールとして、以下のコードを「Mod顧客登録」に貼り付けて下さい。


Sub 顧客一覧へ登録()
  Dim r0 As Long       '行番号ワーク
  Dim r1 As Long, c1 As Long '顧客一覧の見出しの行,列位置
  Dim r2 As Long, c2 As Long '顧客登録の行,列位置
  Dim rngFind As Range    'Findの結果保存

  Call マクロ開始処理
  
  r1 = 開始セル取得("顧客一覧").Row  '顧客一覧の開始行位置を取得
  c1 = 開始セル取得("顧客一覧").Column '顧客一覧の開始列位置を取得
  r2 = 開始セル取得("顧客登録").Row  '顧客登録の開始行位置を取得
  c2 = 開始セル取得("顧客登録").Column '顧客登録の開始列位置を取得
    
  '顧客番号が未入力は処理終了
  If IsEmpty(シート取得("顧客登録").Cells(r1, c1 + 1)) Then
    MsgBox シート取得("顧客登録").Cells(r2, c2) & "を入力して下さい。"
    Call マクロ終了処理
    Exit Sub
  End If
  
  With シート取得("顧客一覧")
    '顧客登録の顧客番号で、顧客一覧の顧客番号を検索
    Set rngFind = .Range(.Cells(r1 + 1, c1), .Cells(.Cells.SpecialCells(xlLastCell).Row, c1)) _
            .Find(What:=シート取得("顧客登録").Cells(r2, c2 + 1), _
            After:=.Cells(r1 + 1, c1), _
            LookIn:=xlFormulas, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            MatchByte:=False)
    If rngFind Is Nothing Then '見つからなかった場合
      r0 = .Cells.SpecialCells(xlLastCell).End(xlUp).Row + 1
    Else
      r0 = rngFind.Row '検索された行
    End If
    Do Until IsEmpty(.Cells(r1, c1)) '顧客一覧の見出し列の終わりまで
      '顧客登録←顧客一覧
      .Cells(r0, c1) = シート取得("顧客登録").Cells(r2, c2 + 1)
      c1 = c1 + 1 '顧客一覧の列を右に
      r2 = r2 + 2 '顧客登録の行を2つ下に
    Loop
  End With


  シート取得("顧客一覧").Select '指定シートへ移る
  Cells(r0, 開始セル取得("顧客一覧").Column).Select '開始位置の右横のセルを選択


  Call マクロ終了処理
End Sub


Subモジュール、「顧客一覧より取得」とほぼ同様です。


変更箇所を太字にしています。

たったこれだけの変更で実現されています。


前回に書きましたが、いかにコードの使い回しが重要かということです。


If rngFind Is Nothing Then '見つからなかった場合
  r0 = .Cells.SpecialCells(xlLastCell).End(xlUp).Row + 1
Else
  r0 = rngFind.Row '検索された行
End If
「顧客一覧より取得」では、見つからなかった場合は、Exit Subしていましたが、

今度のモジュールでは、新規登録となりますので、

一覧データの最終行を求めます。

.Cells.SpecialCells(xlLastCell)は使用している最終行です。

ここで使用しているというのは、データが入っているとは限らず、書式のみ設定してあるセルも含みます。

.End(xlUp)で、そのセルより上にデータのある行へ移動します。

.Rowは、その行ですね。

これは、Cells(Rows.Count, 1).End(xlUp).).Rowとする方が一般的だと思います。

あえて、.Cells.SpecialCells(xlLastCell)を使用してみました、お勉強です。


.Cells(r0, c1) = シート取得("顧客登録").Cells(r2, c2 + 1)
は、「顧客一覧より取得」と向きが逆なだけです。

「顧客一覧」→「顧客登録」と「顧客登録」→「顧客一覧」ですから、当たり前ですね。


シート取得("顧客一覧").Select

Cells(r0, 開始セル取得("顧客一覧").Column).Select

この2行で、更新した行の顧客番号のセルに移動します。



それでは、このマクロをファンクションに登録しましょう。


「顧客一覧」→「顧客登録」で使用した、で良いでしょう。


Sub ファンクションF1()
  Dim strWork As String

  Select Case True
    Case ActiveSheet Is シート取得("顧客一覧")
      If Not IsEmpty(Cells(ActiveCell.Row, 開始セル取得("顧客一覧").Column)) And _
        ActiveCell.Row > 開始セル取得("顧客一覧").Row Then
        strWork = Cells(ActiveCell.Row, 開始セル取得("顧客一覧").Column)
        Call 顧客登録シート作成
        開始セル取得("顧客登録").Offset(0, 1) = strWork
        Call 顧客一覧より取得
      End If
    Case ActiveSheet Is シート取得("顧客登録")
      Call 顧客一覧へ登録
  End Select
End Sub


特に説明は必要ないと思います。


F1を押されたシートが「顧客一覧」の場合に、Subモジュール「顧客一覧へ登録」を起動します。

これで、F1押下で、「顧客登録」で入力した内容が、「顧客一覧」に更新されます。






同じテーマ「エクセル顧客管理」の記事

第12回.最終行の判定、Rangeオブジェクトと配列、高速化の為に
第13回.コントロールのボタンを配置
第14回.オブジェクトとプロパティの真実(GW特別号No1)
第15回.記述による処理速度の違い(GW特別号No2)
第16回.処理速度の向上はどこまでやれば良い(GW特別号No3)
第17回.商品マスタを作成、2段階の可変リスト
第18回.納品書を作成、顧客情報を取得(1)

新着記事 ・・・新着記事一覧を見る

空白セルを正しく判定する方法2|ExcelマクロVBA技術解説(5月6日)
フルパスをディレクトリ、ファイル名、拡張子に分ける|ExcelマクロVBA技術解説(4月15日)
テキストボックスの各種イベント|Excelユーザーフォーム入門(4月9日)
フォルダ(サブフォルダも全て)削除する、Optionでファイルのみ削除|ExcelマクロVBAサンプル集(4月4日)
最後の空白(や指定文字)以降の文字を取り出す|エクセル関数超技(3月26日)
先頭の数値、最後の数値を取り出す|エクセル関数超技(3月26日)
Excelファイルを開かずにシート名をチェック|ExcelマクロVBAサンプル集(3月23日)
数式の参照しているセルを取得する|ExcelマクロVBAサンプル集(3月18日)
CSVの読み込み方法(改の改)|ExcelマクロVBAサンプル集(3月17日)
変数とプロシージャーの命名について|ExcelマクロVBA技術解説(2月12日)

アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|ExcelマクロVBA入門
2.ひらがな⇔カタカナの変換|エクセル基本操作
3.RangeとCellsの使い方|ExcelマクロVBA入門
4.Range以外の指定方法(Cells,Rows,Columns)|ExcelマクロVBA入門
5.徹底解説(VLOOKUP,MATCH,INDEX,OFFSET)|エクセル関数超技
6.変数とデータ型(Dim)|ExcelマクロVBA入門
7.セルの参照範囲を可変にする(OFFSET,COUNTA,MATCH)|エクセル関数超技
8.セルのコピー&値の貼り付け(PasteSpecial)|ExcelマクロVBA入門
9.CSVの読み込み方法|ExcelマクロVBAサンプル集
10.定数と型宣言文字(Const)|ExcelマクロVBA入門



  • >
  • >
  • >
  • 顧客登録より顧客一覧へ更新

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。




    ↑ PAGE TOP