エクセル顧客管理
顧客登録より顧客一覧へ更新

Excelマクロを駆使したカスタマイズ可能なエクセル顧客管理、エクセルVBAの学習教材
公開日:2013年5月以前 最終更新日:2021-02-12

第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(r2, c2 + 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押下で、「顧客登録」で入力した内容が、「顧客一覧」に更新されます。





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

第8回.顧客一覧より顧客データを取得
第9回.イベントを使ってマクロを起動させる
第10回.コーディングとデバッグ
第11回.顧客登録より顧客一覧へ更新
第12回.最終行の判定、Rangeオブジェクトと配列、高速化の為に
第13回.コントロールのボタンを配置
第14回.オブジェクトとプロパティの真実(GW特別号No1)
第15回.記述による処理速度の違い(GW特別号No2)
第16回.処理速度の向上はどこまでやれば良い(GW特別号No3)
第17回.商品マスタを作成、2段階の可変リスト
第18回.納品書を作成、顧客情報を取得(1)


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

ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
累計を求める数式あれこれ|エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE|エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。|エクセル雑感(2023-12-28)
VBAでクリップボードへ文字列を送信・取得する3つの方法|VBA技術解説(2023-12-07)
難しい数式とは何か?|エクセル雑感(2023-12-07)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.並べ替え(Sort)|VBA入門
8.条件分岐(IF)|VBA入門
9.セルのクリア(Clear,ClearContents)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門




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


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



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