[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロで上書きを追加したい』（エミリー）
はじめまして、マクロ初心者です。 データベース本を見ながら下記マクロを設定しました。
入力シートと請求管理一覧データがあり、入力シートに 「呼び出し」のマクロボタンと、「新規保存」のマクロボタンを 設定しています。
今出来ることは、 ①入力シートから→請求管理データシートに新規保存ができる。 ②請求管理一覧データに既に登録済みのデータを、 入力シートの請求管理NO検索で呼び出すことができる。
の2点です。今のままですと、②でせっかく呼び出した既存データ に変更を加え、保存すると、以前のもの（削除されずそのまま）と、 さらに今回のデータが保存され、請求管理NOが重複してしまいます。
②で呼び出したデータを入力シート画面上で上書き変更して、 変更情報を、請求管理データに上書き保存したいと思っています。 「呼び出し」「新規保存」以外に、「上書き」のマクロボタンを 設定したいのですが・・・よくわかりません。
是非、ご教授いただけませんでしょうか。 宜しくお願い致します。
――――――――――――――――――――――――
Option Explicit
Sub 新規レコード転記()
Dim motoSht As Worksheet, sakiSht As Worksheet, sakiRng As Range, i As Long
Dim motoHani()
'変数の宣言
Set motoSht = Sheets("入力シート")
'入力用のシートをセット
Set sakiSht = Sheets("請求管理データシート")
'蓄積用のシートをセット
motoHani = Array("C4", "C6", "E6", "C7", "E7", "C9", "E9", "G9", "C10", "C12", "G12", "C13", "C14", "C15", "C16", "E16", "G16", "C17", "E17", "G17", "G7", "C19", "F19")
'転記したいセルの位置を配列に格納
Set sakiRng = sakiSht.Range("B" & Rows.Count).End(xlUp).Offset(1)
'新規レコードの入力位置を取得
For i = 0 To UBound(motoHani)
sakiRng.Offset(0, i).Value = motoSht.Range(motoHani(i)).Value
Next
'配列に指定した順番でレコードの値を転記
MsgBox "入力を完了しました。"
End Sub
Sub 新規レコード転記2()
Dim motoSht As Worksheet, sakiSht As Worksheet, sakiTbl As Range, sakiRng As Range, i As Long
Dim lastRec As Range, newRec As Range
Dim motoHani()
Application.ScreenUpdating = False '画面の更新をストップ
Set motoSht = Sheets("入力シート")
Set sakiSht = Sheets("請求管理データシート")
motoHani = Array("C4", "C6", "E6", "C7", "E7", "C9", "E9", "G9", "C10", "C12", "G12", "C13", "C14", "C15", "C16", "E16", "G16", "C17", "E17", "G17", "G7", "C19", "F19")
Set sakiTbl = sakiSht.Range("請求管理データマスタ")
Set sakiRng = sakiTbl.Cells(sakiTbl.Rows.Count, 1).Offset(1)
For i = 0 To UBound(motoHani)
sakiRng.Offset(0, i).Value = motoSht.Range(motoHani(i)).Value
' motoSht.Range(motoHani(i)).MergeArea.ClearContents
Next
Set lastRec = sakiTbl.Rows(sakiTbl.Rows.Count)
Set newRec = lastRec.Offset(1)
lastRec.Copy
newRec.PasteSpecial xlFormats
Set sakiTbl = sakiTbl.Resize(sakiTbl.Rows.Count + 1)
Names("請求管理データマスタ").RefersTo = sakiTbl
Application.ScreenUpdating = True '画面の更新を元に戻す
MsgBox "入力を完了しました。"
End Sub
Sub 連番表示()
Dim tmpNo As Integer, myTbl As Range
'変数の宣言
Set myTbl = Range("請求管理データマスタ")
'テーブルのセット
tmpNo = Application.WorksheetFunction.Max(myTbl.Columns(1))
'1フィールド目の最大値を求める
MsgBox "最新No.は、" & tmpNo + 1 & "です。"
End Sub
Function 連番取得(myTbl As Range, myFld As Integer)
Dim tmpNo As Integer
tmpNo = Application.WorksheetFunction.Max(myTbl.Columns(myFld))
連番取得 = tmpNo + 1
End Function
Sub 請求管理NO検索()
Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer
'変数の宣言
tmpInt = Sheets("入力シート").Range("C4").Value
'検索する値を取得
motoHani = Array("C6", "E6", "C7", "E7", "C9", "E9", "G9", "C10", "C12", "G12", "C13", "C14", "C15", "C16", "E16", "G16", "C17", "E17", "G17", "G7", "C19", "F19")
'転記する位置を設定
Set myRng = Range("請求管理データマスタ").Columns(1).Find(tmpInt, LookAt:=xlWhole)
'請求管理データシートの1フィールド目を対象に検索
If myRng Is Nothing Then
MsgBox "該当するレコードはありませんでした"
Exit Sub
End If
'検索値が無かった場合は処理を抜ける
For i = 0 To UBound(motoHani)
Range(motoHani(i)).Value = myRng.Offset(0, i + 1)
Next
'検索値が見つかったセルを元にレコードの情報を転記
End Sub
こんにちは。
＞「呼び出し」「新規保存」以外に、「上書き」のマクロボタンを ＞設定したいのですが
ご質問への回答ではないのですが、「新規保存」と「上書き」を分けるよりも、 「保存」1つにして、請求管理NO検索によって新規（NOがない場合）か上書き（既存の場合）か コード内で判定するほうが、使いやすく、メンテもしやすいのではないでしょうか。 （似たようなツールを作ったことがありましたので）
（コタ） # それにしても、本を見ながらだけでこれだけのコードが書けるのは、すごいですね。
コタさん、早速のお返事ありがとうございます！
仰るとおり、コード内で判定する方法にしたいです・・ が・・どう変更すればいいのか？応用ができません。
出来ましたら、上記マクロのコードを変更して 教えていただけないでしょうか？
すみません、ずうずうしいのですが・・ 是非ともよろしくお願い致します☆
（エミリー）
←行頭を半角スペースで始めると書き込みの改行位置が反映されます。
では、どう変更すればいいかを、いっしょに考えていきましょうか。 （といっても私はレスが遅いので、その点はごかんべんを）
まず提示されたコードの確認です。 以下の5つありますが、 (1)入力シートから→請求管理データシートに新規保存ができる。 (2)請求管理一覧データに既に登録済みのデータを、入力シートの請求管理NO検索で呼び出すことができる。 はそれぞれ、どのコードを使用しているのでしょうか。 ※丸付き文字は機種依存のため、カッコで代用します。
Sub 新規レコード転記() Sub 新規レコード転記2() Sub 連番表示() Function 連番取得(myTbl As Range, myFld As Integer) Sub 請求管理NO検索()
また、↓の転記コードは、なぜ2つあるのでしょうか。 Sub 新規レコード転記() Sub 新規レコード転記2()
（コタ）
コタさん、おはようございます！ 早速、本日もよろしくお願い致します☆
(2)請求管理一覧データに既に登録済みのデータを、 入力シートの請求管理NO検索で呼び出すことができる。
は、→Sub 請求管理NO検索() のコードを使用しています。
(1)入力シートから→請求管理データシートに新規保存ができる。 は、→Sub 新規レコード転記2() のコードを使用しています。
そして、 また、↓の転記コードは、なぜ2つあるのでしょうか。 Sub 新規レコード転記() Sub 新規レコード転記2() が2つある理由は、 本に書いてあったのをそのまま入力したので・・・ よく分かりません。。
すみません・・本当に初心者なので・・ あまり理解できていないところ多いです（恥ずかしながら・・）
コタさん、お忙しいところ恐縮ですが・・ 来週、社内プレゼン？するので・・・ 出来れば本日中の完成を目指しています！
是非とも宜しくお願い致します☆
（エミリー）
＞来週、社内プレゼン？するので・・・出来れば本日中の完成を目指しています ごめんなさい、私にはできません。 時間の制約がなく、内容を一緒に理解しながら完成を目指すのであれば、お手伝いさせていただきますが、 そうでないのなら、他の方のご回答をお待ちください。
（コタ）
こんにちは
転記する際に請求管理NOがあれば上書き、無ければ「新規レコード転記」をCallします。
「新規レコード転記」「新規レコード転記2」の違いは見てないので分かりません。
Sub 請求管理NO検索_転記()
'変数の宣言
Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer
Dim motoSht As Worksheet
'入力用のシートをセット
Set motoSht = Sheets("入力シート")
'検索する値を取得
tmpInt = motoSht.Range("C4").Value
'転記する位置を設定
motoHani = Array("C6", "E6", "C7", "E7", "C9", "E9", "G9", "C10", _
"C12", "G12", "C13", "C14", "C15", "C16", "E16", _
"G16", "C17", "E17", "G17", "G7", "C19", "F19")
'請求管理データシートの1フィールド目を対象に検索
Set myRng = Range("請求管理データマスタ").Columns(1).Find(tmpInt, LookAt:=xlWhole)
'検索値が無かった場合は処理を抜ける。または新規レコード転記を Call する。
If myRng Is Nothing Then
MsgBox "該当するレコードはありませんでした"
'新規レコード転記を Call する場合。
Call 新規レコード転記
Exit Sub
End If
'検索値が見つかったセルに入力シートのレコードの情報を転記
For i = 0 To UBound(motoHani)
myRng.Offset(0, i + 1).Value = motoSht.Range(motoHani(i)).Value
Next
End Sub
（ウッシ）
出来ました！
本当に、嬉しいです！！
これを機会にもう少しマクロのコードの
勉強しようと思います。
本当にありがとうございました。
（エミリー）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.