★★★★★★Access2000VBA・Excel2000VBA独学～配列を利用しての、新規レコードの一括セルデータ（レコード）追加のプログラム・その２。～顧客マスタ入力～ワークシートをフォームに見立てて、縦長のデータの行と列を入れ替えながら他のシートへ転記するサンプル。～ | 無駄なお金と時間がない方・零細企業様・独立したい方・個人事業主の方・営業さん・経理さん・学生さん・就活生さん・小学生のお子様、中高生の子たちのための、　　　　「小さな会社の兼任なんちゃって社内SE・パソコン管理術・の基礎知識」

★★★★★★Access2000VBA・Excel2000VBA独学～配列を利用しての、新規レコードの一括セルデータ（レコード）追加のプログラム・その２。～顧客マスタ入力～ワークシートをフォームに見立てて、縦長のデータの行と列を入れ替えながら他のシートへ転記するサンプル。～
　　
※まだ書きかけです。すみません。
※間違ってたらすみません。
※メモ書きなので、自分でも意味不明な箇所も多いです。ごめんなさい。
　　
※関連記事
『 ★★★★★★Access2000VBA・Excel2000VBA独学～配列を利用しての、新規レコードの一括セルデータ（レコード）追加のプログラム。（テーブル化した表の場合と、そうじゃない表の場合）～
『 ★★★★★★★★★★★★★★★★Access2000VBA・Excel2000VBA独学～最終行の行番号を求める方法～』
　　
　　

　　
　　
★ サンプルファイルダウンロード

こちらからダウンロードしてください。

Esetでウィルスチェックしてあります。

ファイルを開いたら、Alt＋F11 でVBEditorを開きます。
その中の「本番」というモジュールをダブルクリックすると、「SampleNewRecAddAtherSht04()」とという今回のメインのプロシージャを確認できます。

そのほかにも少し、他のコマンドボタンがらみのプログラムやイベントプロシージャも追加してありますので一度ご覧になってみてください。

　　
　　
★ はじめに
ここでは、「Excelのショボいユーザーフォーム」よりも、シートをフォームがわりに使った方が便利な例を挙げさせていただきました。（特に自分だけで使うなら。他の人にも使わせるならダメかもだけど。）

Ctrlキーを押しながらマウスのホイールを回すと、拡大表示や縮小表示ができますので、ユーザーフォーム使うよりも便利だと思います。高齢者や文字が小さくて見えない人にも対応できます。ちょっとしたメモもシート上にできますし。配列でセルの値も一発で取得し、かつ、そのデータの行と列の入れ替えもすぐにできますし。
シートやセルの設定を自分好みに変えることもできます。（自分で使うだけだから）

項目が増えたら、例えば本記事のサンプルなら、フォーム代わりのシートに増やした順番通りに、一覧のシートにも列を増やして、ファイルを再起動するだけです。

Excelのユーザーフォームを使うといちいちテキストボックスの値をループなどで書き出さないといけないし、拡大縮小表示やその他のシートの便利な機能も使えないので不便だと思います。

ただ、他人に使わせたい場合は、「ユーザーに不要なことはさせたくない」という場合には、ユーザーフォームのほうがいい場合もあるかもしれません。でも僕ならExcelのショボいユーザーフォーム使うくらいなら、各種設定が50倍はラクなAccessフォームを使います。

Excelのユーザーフォームは、「これはExcelのユーザーフォームでしか絶対にできない！」「Accessフォームなんかじゃかえって不便！」というときに使います。（例えばユーザーに何らかの条件を選ばせる等々のちっちゃなフォームとか、その他諸々。）

それ以外（ある意味規模の大きなフォーム）は、やはり、シートをフォーム替わりに使います。

あと、ユーザーフォームのほうが「見た目的にカッコイイ気がする」かもしれませんが、大変無礼ですみませんが、そういう考え方は（上から目線で本当にすみませんがでもマジで）「愚の骨頂」といいますか・・・、「効率のことを無視しています」ので、無駄だらけとなり、コスパも最悪となります。誰かが言っていても絶対に真似しなようにしてください。

そもそも「Excelのユーザーフォーム」なんて、使ったところで効率が悪いことが少なくないのに、なぜそんなものを、しかも、例えば顧客データ入力のような（不要なシーンで）わざわざ使おうとするのか、僕にはまったく理解できません。

ユーザーフォームや表操作がらみで「クラスモジュールでこんなことまでできちゃうよ！」なんて言ってる本やサイトを見かけますが、Accessのフォーム機能を使えば十数秒か数十秒で終わるような「事務系のよくある機能」の作りこみを、Accessの数万をケチって無駄なクラスモジュールをいちいち作るなんて、本当に「愚の骨頂」だと思います。
Office365ならAccessタダで付いてくる・・・って言っても過言ではないくらい安いですし。いつも話が逸れてすみませんが、小規模（同時に使うのが5台以下）なら、Accessランタイムすら必要なくて、Accessが使えるわけですから、COMオートメーションでAccessフォームを呼び出してExcelと連携プレーするほうが、「圧倒的にコスパがイイ」です。
全部をExcelだけでやろうとするなんて、本当に「愚か」だと思います。だって、Office365ならAccessタダみたいなもんなんですから。なぜ『タダで・かつ・Excelユーザーフォームの50倍は効率がいい』のに学習しようとしないのか、その意味がわかりません。
もちろん、全部をAccessだけでやろうとするのも「バカの極み」です。

話を戻します。

もっというと、表の操作ならクラスモジュールなんか使わなくても、ADOやDAOなどでオブジェクトとして扱えますから、一般的なビジネス集計などなら、まず、クラスモジュールなんて必要ないと思います。

そしてExcelのショボい「ユーザーフォーム」なんか使うよりも、シートをフォーム替わりにするほうがよっぽど色んな機能が使えます。
色んなものが動かせます。
そして、シートをフォーム替わりに使うと、目的次第ではAccessのフォームをしのぐこともできてしまします。非常に優秀だと思います。

見た目より、効率や作り変えがラクなほう重視がいいです。
特に自分だけが使う場合、売るソフトを作るわけではないので、「見た目なんてどうでもいい」のです。
見た目にこだわるとコスパが最悪になります。ご注意ください。
　　
　　

※補足：Excelのユーザーフォームは本当にムダ？

もちろん、Excelのユーザーフォームは、
「まったくの役立たず」という意味ではありません。

・顧客登録には必ずしも必要ない（というか、基本、必要ない。）、
・Excelのユーザーフォームの妄信は危険、
・「Excelのユーザーフォームのほうがなんとなくカッコイイ」という意識は
　　「ダメ設計の典型」、
というだけで・・・。

Excelのユーザーフォームは、何かの動作の途中で、「ちょっとした設定」をユーザーにさせるときには、便利で、ユーザーフォームにしかできないことが結構ある、と思います。

ただ、繰り返しになりますが、「顧客登録」というシーンには、（もちろん使いたければ使えばいいですが）、基本、必ずしも必要ではありません。本記事でお示ししたとおりです。

シートをフォームに見立てるほうが、「特定のセルの入力について」、入力規則等々で各種制限や日本語入力モード設定、また、単純に拡大縮小などもできますし、色々と便利だと思います。
もちろん、VBAによって、Changeイベントによっても「特定のセルの入力について」、その他のことをチェックすることも可能です。

それでは対応できないなら、「そのときにはじめて」、Excelのユーザーフォームを使うことも選択肢に入れてもいいですが、ループコードを書かないといけなかったり、場合によっては名前範囲の無駄な指定や関連コードが必要、フィルタや検索が使えない、また、単純に拡大縮小機能など、「結構作りこまないといけなくなるのが超面倒くさい・非効率」になります。
それならフォームはフォームでも、「AccessとAccessのフォーム」を使うほうが、数秒で設定が終わるシーンが少なくないので、そちらを使った方がはるかに効率的・・・ということのほうが「事実」「現実」です。

結局、
「Accessの数万と学習時間をケチって、Excelで無駄な苦労を頑張る」か、
「ケチらないで素直にAccessとAccessフォームを使う」か、
それを両てんびんにかけるわけですが、
「VBAを絶対に使わない」なら話は別ですが、「VBAを使う」のですから、
悩ましいかもしれませんが、後者で行ってADOやQueryTableオブジェクトなども学ぶと、
確かに最初は多少苦労するかもしれませんが、
でも、そのあとが色々と便利になるとは思います。
　　
　　
　　

★ 核となるテストプログラム

基本的には以下の数行で今回の目的は達成できます。

（この段階では、）
疑似フォーム側（Sheet1）の行が増えたら、それに応じて同じ位置にSheet2の列も増やし、さらにそれに応じて、以下の2か所のプログラムのセル範囲指定を書き換えます。
・v_CelData = ActiveWorkbook.Worksheets("Sheet1").Range("B3:B17")
・Worksheets("Sheet2").Cells(l_TrgNewRow, 1).Range("A1:O1") = v_CelData

疑似フォーム側（Sheet1）の行の順序を入れ替えた場合は、それに応じてSheet2の列の順序を入れ替えればOKです。
プログラムの変更は要りません。

'
'

'最初のコード。
'シートをフォーム替わりに使って、配列も利用すると、
'たったこれだけでも転記（行列を入れ替えながらの）が
'可能なことを知ってください。

Sub SampleNewRecAddAtherSht01()

    Dim v_CelData   As Variant
    Dim l_TrgNewRow As Long

    v_CelData = ActiveWorkbook.Worksheets("Sheet1").Range("B3:B17")  'セルの値の取得（縦長の2次元配列になります）
    v_CelData = Application.WorksheetFunction.Transpose(v_CelData)   '行列の入れ替え（縦長の2次元配列を横の1次元配列に）

    l_TrgNewRow = Worksheets("Sheet2").UsedRange.Rows.Count + 1      '転記先の最新行を取得

    Worksheets("Sheet2").Cells(l_TrgNewRow, 1).Range("A1:O1") = v_CelData   '最新行へ転記を実行

End Sub
'
'

'最初のコード。

'シートをフォーム替わりに使って、配列も利用すると、

'たったこれだけでも転記（行列を入れ替えながらの）が

'可能なことを知ってください。

Sub SampleNewRecAddAtherSht01()

Dim v_CelData As Variant

Dim l_TrgNewRow As Long

v_CelData = ActiveWorkbook.Worksheets("Sheet1").Range("B3:B17") 'セルの値の取得（縦長の2次元配列になります）

v_CelData = Application.WorksheetFunction.Transpose(v_CelData) '行列の入れ替え（縦長の2次元配列を横の1次元配列に）

l_TrgNewRow = Worksheets("Sheet2").UsedRange.Rows.Count + 1 '転記先の最新行を取得

Worksheets("Sheet2").Cells(l_TrgNewRow, 1).Range("A1:O1") = v_CelData '最新行へ転記を実行

End Sub

　　
　　
★ 前項のプログラムを少し汎用的っぽく？作り変えたもの

フォーム側の行が増えたら、それに応じて同じ位置にSheet2の列も増やします。
前項のプログラムのような、行が列が増えることに伴ってのプログラムの変更は要りません。

フォーム側の行の順序を入れ替えた場合は、それに応じてSheet2の列の順序を入れ替えればOKです。
こちらもプログラムの変更は要りません。

'
'

'Sheet1の行の項目の増減に対応できるようにするために、
'グローバル変数として追加しました。
Public i_SrcRngLastRow01   As Integer



Sub Auto_Open()

   'Sheet1の行の項目の増減に対応できるように追加しました。
   'Sheet1の項目名の最終行を、グローバル変数の
   '「i_SrcRngLastRow01」に保存（代入）しておきます。
   '「i_SrcRngLastRow01」はグローバル変数なので、
   'このファイルが開いている間じゅう、ずーっと、その値を保持しています。
   'ただし、Sheet1の行の項目の増減をさせると、それに呼応して、
   '値が変化します。（行を１行増やせば、値が１ずつ増え、減らせばその逆です。）
   
    i_SrcRngLastRow01 = ThisWorkbook. _
                         Worksheets("Sheet1"). _
                          Cells(Rows.Count, 1). _
                           End(xlUp).Row

End Sub




Sub SampleNewRecAddAtherSht04()
'Sheet1の行の項目の増減に対応できるように追加しました。
    
    Dim o_SrcRng01          As Range
    Dim o_TrgSht01          As Worksheet
    Dim s_TrgRngString01    As String
    Dim v_CelData           As Variant
    Dim i_Cel_Kosuu         As Integer
    Dim l_TrgRowNm          As Long
    Dim l_TrgNewRow         As Long
    Dim i_Answ01            As Integer

    
    Set o_SrcRng01 = ThisWorkbook. _
                      Worksheets("Sheet1"). _
                       Range("B3:B" & i_SrcRngLastRow01)
    'ソース（転記モト）となるセル範囲（データの範囲）を指定
    '行数の指定には、グローバル変数の「i_SrcRngLastRow01」を使っています。
            
            
            
    Set o_TrgSht01 = ThisWorkbook. _
                      Worksheets("Sheet2")
    '転記先となる「シート」を指定
    'ただし、転記先に列名が入力されてないと正常に動きません。
    '列名無しで・かつ・UsedRangeをどうしても使いたいなら、
    '列名が無い分、次のコードの「＋１」を「＋２」にする必要がります。
    'でないと転記先シートの２行目に上書きされていくだけになってしまいます。
    
    
    s_TrgRngString01 = o_TrgSht01.UsedRange.Rows(1).Address
'    s_TrgRngString01 = "A1:O1"
    'のちのちのメイン転記のコードで何故か、コマンドボタンから呼び出したとたん、
    'エラーになってしまうので、転記先のセル範囲の指定方法について、
    'Cellsでの指定をRangeでのセル指定に変えるために、このコードを追加しました。
    ' 「s_TrgRngString01 = "A1:O1"」 と、"A1:O1"と直接のセル指定をしてももちろんOK。
    '  ですが、
    '  のちのメインの転記のコードでは、転記先の位置の指定に、
    ' 「o_TrgSht01.Rows(l_TrgRowNm).Range(s_TrgRngString01)」と、
    '  Range.Rangeプロパティを使って転記先を指定しています。
    '  これはすなわち、
    ' 「o_TrgSht01.Rows(l_TrgRowNm) ＝新しい行」の先頭セルをを起点とした
    '  相対的なセル指定になります。
    '  これは、最新行の先頭セルを起点を「A1」とみなして、「O1」まで、
    '  という転記先のセル指定をしています。
    '  ここで「o_TrgSht01.UsedRange.Rows(1).Address」と書くと、
    '  「$A$1:$O$1」が自動的に返ってくるのですが、
    '  それを、そこでの相対的なセル指定に使えます。
    '  これは「列数が増えて列名が増えても自動的に判断してくれる」
    '  ので、「このまま書き換える必要が無く放っておけばいい」という意味でもあります。
    '  ですので、ここでは（後で手抜きしたいので）、s_TrgRngString01 = "A1:O1" とせずに
    ' 「s_TrgRngString01 = o_TrgSht01.UsedRange.Rows(1).Address」としてみました。
    '  でも繰り返しますが、のちのちエラーが出るかもしれないし誤作動も起こカモなので、
    ' 「s_TrgRngString01 = "A1:O1"」 と書いて、その都度、手修正しても何の問題もありません。
    
    
    l_TrgNewRow = o_TrgSht01.UsedRange.Rows.Count + 1
    '値の転記先の行を今のセル範囲の次の行に指定。
    'UsedRangeを使うと、入力されていない行の高さや罫線・色などを変えたときに
    '返ってくる値がメチャクチャになってしまうので、ここではそれらの設定は
    '「変えない前提」です。手抜きしたかったのもあって。
    'もし高さなどを変える可能性があるなら、一般的な指定方法のほうがいいかもです。
    
    
    v_CelData = o_SrcRng01.Value
    '縦長のセル範囲の値を、Variant型の変数に代入。
    'この場合、Variant型の変数の中で、自動的に縦長の「２」次元配列に変換されます。
    

    v_CelData = Application.WorksheetFunction.Transpose(v_CelData)
    '縦長の２次元配列を、横長（というか”普通”）の「１」次元配列に変換します。
    
    
'    i_Cel_Kosuu = UBound(v_CelData)  '列番号を設定したいのでに、配列の要素数を取得
'     'メインの転記のところで、転記先のセル指定を、
'     'エラーが出てしまうため、Cellsでの指定からRangeでの指定に変えたので
'     'このコードは不要になりました。なので使用禁止。

     
    l_TrgRowNm = l_TrgNewRow
    '↑転記先の行を、転記先のシートの今のセル範囲の次の行（つまり最新行）に指定します。


    o_TrgSht01.Rows(l_TrgRowNm).Range(s_TrgRngString01).Value = v_CelData
    'なぜか↓のコードがコマンドボタンから呼び出すとエラーになってしまうので↑のコードでやります。
'    o_TrgSht01.Rows(l_TrgRowNm).Range(Cells(1, 1), Cells(1, i_Cel_Kosuu)).Value = v_CelData
    
    '↑指定した行の指定したセル範囲（要素数分のセル）に、転記。
    '  Range.Rangeプロパティを使って転記先を指定しているので、
    '  o_TrgSht01.Rows(l_TrgRowNm) を起点とした相対的なセル指定になります。
    ' なので、「s_TrgRngString01」つまり、「$A$1:$O$1」のような指定が使えます。
    '　新規の行を指定すれば、「１件の新規レコード追加」という意味になります。
    '     ※Valueを省略するとエラーになることがあるかも？。



    '以下、転記モトのソースのデータを消すかどうかの処理
    i_Answ01 = MsgBox("追加が完了しました。今のこの入力データを消してもいいですか？", vbDefaultButton2 + vbYesNoCancel, "データの消去")
    
    If i_Answ01 = 2 Then      'キャンセル
        
    ElseIf i_Answ01 = 6 Then  'はい
        o_SrcRng01.ClearContents
    ElseIf i_Answ01 = 7 Then  'いいえ
    
    Else
    
    End If
    
    '先頭のセルに戻る。
    o_SrcRng01.Range("A1").Activate
    
End Sub
'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

'Sheet1の行の項目の増減に対応できるようにするために、

'グローバル変数として追加しました。

Public i_SrcRngLastRow01 As Integer

Sub Auto_Open()

'Sheet1の行の項目の増減に対応できるように追加しました。

'Sheet1の項目名の最終行を、グローバル変数の

'「i_SrcRngLastRow01」に保存（代入）しておきます。

'「i_SrcRngLastRow01」はグローバル変数なので、

'このファイルが開いている間じゅう、ずーっと、その値を保持しています。

'ただし、Sheet1の行の項目の増減をさせると、それに呼応して、

'値が変化します。（行を１行増やせば、値が１ずつ増え、減らせばその逆です。）

i_SrcRngLastRow01 = ThisWorkbook. _

Worksheets("Sheet1"). _

Cells(Rows.Count, 1). _

End(xlUp).Row

End Sub

Sub SampleNewRecAddAtherSht04()

'Sheet1の行の項目の増減に対応できるように追加しました。

Dim o_SrcRng01 As Range

Dim o_TrgSht01 As Worksheet

Dim s_TrgRngString01 As String

Dim v_CelData As Variant

Dim i_Cel_Kosuu As Integer

Dim l_TrgRowNm As Long

Dim l_TrgNewRow As Long

Dim i_Answ01 As Integer

Set o_SrcRng01 = ThisWorkbook. _

Worksheets("Sheet1"). _

Range("B3:B" & i_SrcRngLastRow01)

'ソース（転記モト）となるセル範囲（データの範囲）を指定

'行数の指定には、グローバル変数の「i_SrcRngLastRow01」を使っています。

Set o_TrgSht01 = ThisWorkbook. _

Worksheets("Sheet2")

'転記先となる「シート」を指定

'ただし、転記先に列名が入力されてないと正常に動きません。

'列名無しで・かつ・UsedRangeをどうしても使いたいなら、

'列名が無い分、次のコードの「＋１」を「＋２」にする必要がります。

'でないと転記先シートの２行目に上書きされていくだけになってしまいます。

s_TrgRngString01 = o_TrgSht01.UsedRange.Rows(1).Address

' s_TrgRngString01 = "A1:O1"

'のちのちのメイン転記のコードで何故か、コマンドボタンから呼び出したとたん、

'エラーになってしまうので、転記先のセル範囲の指定方法について、

'Cellsでの指定をRangeでのセル指定に変えるために、このコードを追加しました。

' 「s_TrgRngString01 = "A1:O1"」と、"A1:O1"と直接のセル指定をしてももちろんOK。

' ですが、

' のちのメインの転記のコードでは、転記先の位置の指定に、

' 「o_TrgSht01.Rows(l_TrgRowNm).Range(s_TrgRngString01)」と、

' Range.Rangeプロパティを使って転記先を指定しています。

' これはすなわち、

' 「o_TrgSht01.Rows(l_TrgRowNm) ＝新しい行」の先頭セルをを起点とした

' 相対的なセル指定になります。

' これは、最新行の先頭セルを起点を「A1」とみなして、「O1」まで、

' という転記先のセル指定をしています。

' ここで「o_TrgSht01.UsedRange.Rows(1).Address」と書くと、

' 「$A$1:$O$1」が自動的に返ってくるのですが、

' それを、そこでの相対的なセル指定に使えます。

' これは「列数が増えて列名が増えても自動的に判断してくれる」

' ので、「このまま書き換える必要が無く放っておけばいい」という意味でもあります。

' ですので、ここでは（後で手抜きしたいので）、s_TrgRngString01 = "A1:O1" とせずに

' 「s_TrgRngString01 = o_TrgSht01.UsedRange.Rows(1).Address」としてみました。

' でも繰り返しますが、のちのちエラーが出るかもしれないし誤作動も起こカモなので、

' 「s_TrgRngString01 = "A1:O1"」と書いて、その都度、手修正しても何の問題もありません。

l_TrgNewRow = o_TrgSht01.UsedRange.Rows.Count + 1

'値の転記先の行を今のセル範囲の次の行に指定。

'UsedRangeを使うと、入力されていない行の高さや罫線・色などを変えたときに

'返ってくる値がメチャクチャになってしまうので、ここではそれらの設定は

'「変えない前提」です。手抜きしたかったのもあって。

'もし高さなどを変える可能性があるなら、一般的な指定方法のほうがいいかもです。

v_CelData = o_SrcRng01.Value

'縦長のセル範囲の値を、Variant型の変数に代入。

'この場合、Variant型の変数の中で、自動的に縦長の「２」次元配列に変換されます。

v_CelData = Application.WorksheetFunction.Transpose(v_CelData)

'縦長の２次元配列を、横長（というか”普通”）の「１」次元配列に変換します。

' i_Cel_Kosuu = UBound(v_CelData) '列番号を設定したいのでに、配列の要素数を取得

' 'メインの転記のところで、転記先のセル指定を、

' 'エラーが出てしまうため、Cellsでの指定からRangeでの指定に変えたので

' 'このコードは不要になりました。なので使用禁止。

l_TrgRowNm = l_TrgNewRow

'↑転記先の行を、転記先のシートの今のセル範囲の次の行（つまり最新行）に指定します。

o_TrgSht01.Rows(l_TrgRowNm).Range(s_TrgRngString01).Value = v_CelData

'なぜか↓のコードがコマンドボタンから呼び出すとエラーになってしまうので↑のコードでやります。

' o_TrgSht01.Rows(l_TrgRowNm).Range(Cells(1, 1), Cells(1, i_Cel_Kosuu)).Value = v_CelData

'↑指定した行の指定したセル範囲（要素数分のセル）に、転記。

' Range.Rangeプロパティを使って転記先を指定しているので、

' o_TrgSht01.Rows(l_TrgRowNm) を起点とした相対的なセル指定になります。

' なので、「s_TrgRngString01」つまり、「$A$1:$O$1」のような指定が使えます。

'　新規の行を指定すれば、「１件の新規レコード追加」という意味になります。

' ※Valueを省略するとエラーになることがあるかも？。

'以下、転記モトのソースのデータを消すかどうかの処理

i_Answ01 = MsgBox("追加が完了しました。今のこの入力データを消してもいいですか？", vbDefaultButton2 + vbYesNoCancel, "データの消去")

If i_Answ01 = 2 Then 'キャンセル

ElseIf i_Answ01 = 6 Then 'はい

o_SrcRng01.ClearContents

ElseIf i_Answ01 = 7 Then 'いいえ

Else

End If

'先頭のセルに戻る。

o_SrcRng01.Range("A1").Activate

End Sub

MENU

関連記事

最近の投稿

カテゴリー

MENU

関連記事

最近の投稿

カテゴリー

タグ