[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『自動計算する列を追加したい』（ぽんくら）
VBA初心者です。
業務で使用しているエクセルファイルに、K列に商品型番、L列に台数を入力すると、AE列に商品金額×台数が自動計算され自動入力されるマクロが書き込まれています（Sheet1）。
このファイルに2列（N列=受注台数、AF列=計上金額）追加し、受注台数を入力すると計上金額が自動で計算・同じ行に入力されるようにコードを追加したいのですが、K・L列に設定されたコードをコピペし、見よう見まねで書き換えてみても自動計算はされませんでした。
どこをどう書き換えれば良いのかご教授いただけないでしょうか？
シートに記載されている情報と従来のコード、自分で追加・書き換えをしたコードをそれぞれ以下に記載します。
・商品型番と商品金額の一覧はSheet2に記載されています。
・Sheet3に列情報が記載されています。
・マクロはModule1と、Sheet1に書かれています。
＜Sheet3の内容＞
シート名 Sheet1 SHEET_NAME_MISSION_LIST
列範囲 A5:AG6
明細開始行 7 行 ROW_MISSION_LIST_SHEET_DETAIL_START
列情報
"本体/オプション
商品型番" 11 列 COL_MISSION_LIST_SHEET_GOODS_CODE
"台数履歴
○台→○台" 12 列 COL_MISSION_LIST_SHEET_BODY_COUNT
"受注
台数" 14 列 COL_MISSION_LIST_SHEET_BODY_COUNT_CONTRACT ←追加列
"合計金額
(自動計算）" 31 列 COL_MISSION_LIST_SHEET_CONTRACT_AMOUNT
"計上金額
(自動計算)" 32 列 COL_MISSION_LIST_SHEET_CONTRACT_ADD_UP ←追加列
シート名 Sheet2 SHEET_NAME_DROPDOWN
列範囲 A5:AD5
明細開始行 6 行 ROW_DROPDOWN_SHEET_DETAIL_START
列情報
"本体/オプション
商品型番" 9 列 COL_DROPDOWN_SHEET_GOODS_CODE
商品金額 10 列 COL_DROPDOWN_SHEET_COST
/////////////////////////////////////////
＜Module1のコード＞
Option Explicit
Public Const SHEET_NAME_CONST = "定数"
Public SHEET_NAME_MISSION_LIST As String
Public ROW_MISSION_LIST_SHEET_DETAIL_START As Long
Public COL_MISSION_LIST_SHEET_GOODS_CODE As Long
Public COL_MISSION_LIST_SHEET_BODY_COUNT As Long
Public COL_MISSION_LIST_SHEET_BODY_COUNT_CONTRACT As Long '受注台数
Public COL_MISSION_LIST_SHEET_CONTRACT_AMOUNT As Long
Public COL_MISSION_LIST_SHEET_CONTRACT_ADD_UP As Long '計上金額
Public SHEET_NAME_DROPDOWN As String
Public ROW_DROPDOWN_SHEET_DETAIL_START As Long
Public COL_DROPDOWN_SHEET_GOODS_CODE As Long
Public COL_DROPDOWN_SHEET_COST As Long
Public Type CellInfo
Value As String
End Type
Public Type GoodsInfo
Code As String
Cost As Long
End Type
Public GoodsInfos() As GoodsInfo
/////////////////////////////////////////
<sheet1のコード>
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim row As Long
Dim col As Long
On Error GoTo Worksheet_Change_Err
row = Target.row
col = Target.Column
If row >= ROW_MISSION_LIST_SHEET_DETAIL_START Then
Select Case col
Case COL_MISSION_LIST_SHEET_BODY_COUNT
' 合計金額セットアップ
If SetupContractAmount(row) = False Then GoTo Worksheet_Change_End
' 計上金額セットアップ
If SetupContractAddUp(row) = False Then GoTo Worksheet_Change_End
Case COL_MISSION_LIST_SHEET_GOODS_CODE
' 合計金額セットアップ
If SetupContractAmount(row) = False Then GoTo Worksheet_Change_End
' 計上金額セットアップ
If SetupContractAddUp(row) = False Then GoTo Worksheet_Change_End
End Select
End If
Worksheet_Change_End:
Exit Sub
Worksheet_Change_Err:
MethodName = SHEET_NAME_MISSION_LIST & " Worksheet_Change"
Call DispErr(Err.Number, Err.Description)
Resume Worksheet_Change_End
End Sub
～～～～～～～～
Private Function SplitCellValue(ByVal row As Long, ByVal col As Long, ByRef rtnValues() As String, _
Optional ByVal bNum As Boolean = False) As Boolean
Dim tmpValues() As String
Dim str As String
Dim i As Long
Dim k As Long
Dim m As Long
SplitCellValue = False
On Error GoTo SplitCellValue_Err
' 改行で分割
rtnValues = Split(Cells(row, col).Value, vbLf)
' 取り消し線の文字を削除
k = 0
For i = 0 To UBound(rtnValues)
str = Empty
For m = 1 To Len(rtnValues(i))
If Cells(row, COL_MISSION_LIST_SHEET_BODY_COUNT).Characters(Start:=k + m, Length:=1).Font.Strikethrough Then
Else
str = str & Mid(rtnValues(i), m, 1)
End If
Next m
rtnValues(i) = str
k = k + Len(rtnValues(i)) + 1
Next i
' 矢印文字がある場合、最新のもののみを対象
For i = 0 To UBound(rtnValues)
If InStr(1, rtnValues(i), "→") > 0 Then
tmpValues = Split(rtnValues(i), "→")
rtnValues(i) = tmpValues(UBound(tmpValues))
End If
If InStr(1, rtnValues(i), "←") > 0 Then
tmpValues = Split(rtnValues(i), "←")
rtnValues(i) = tmpValues(0)
End If
If bNum = True Then
str = Empty
For m = 1 To Len(rtnValues(i))
If LenB(StrConv(Mid(rtnValues(i), m, 1), vbFromUnicode)) = 1 Then ' 1バイト（半角）文字のみ対象
If IsNumeric(Mid(rtnValues(i), m, 1)) Then
str = str & Mid(rtnValues(i), m, 1)
End If
End If
Next m
If str = Empty Then str = "0"
rtnValues(i) = str
End If
Next i
SplitCellValue = True
SplitCellValue_End:
Exit Function
SplitCellValue_Err:
MethodName = SHEET_NAME_MISSION_LIST & " SplitCellValue"
Call DispErr(Err.Number, Err.Description)
Resume SplitCellValue_End
End Function
～～～～～～
Private Function SetupContractAmount(ByVal row As Long) As Boolean
Dim GoodsCodes() As String
Dim BodyCounts() As String
Dim str As String
Dim i As Long
Dim k As Long
Dim m As Long
Dim lRet As Long
SetupContractAmount = False
On Error GoTo SetupContractAmount_Err
If SplitCellValue(row, COL_MISSION_LIST_SHEET_GOODS_CODE, GoodsCodes) = False Then GoTo SetupContractAmount_End
If SplitCellValue(row, COL_MISSION_LIST_SHEET_BODY_COUNT, BodyCounts, True) = False Then GoTo SetupContractAmount_End
' 商品型番の個数と台数の個数が一致しているかチェック
If Not Not GoodsCodes Then
Else
Call DispLog("本体商品型番が入力されていません。")
GoTo SetupContractAmount_999
End If
If Not Not BodyCounts Then
Else
Call DispLog("本体台数が入力されていません。")
GoTo SetupContractAmount_999
End If
If UBound(GoodsCodes) <> UBound(BodyCounts) Then
Call DispLog("本体商品型番[" & UBound(GoodsCodes) + 1 & _
"個]と本体台数[" & UBound(BodyCounts) + 1 & "個]の個数が一致していません。")
GoTo SetupContractAmount_999
End If
' 合計金額算出
lRet = 0
Cells(row, COL_MISSION_LIST_SHEET_CONTRACT_AMOUNT).Value = lRet
For i = 0 To UBound(GoodsCodes)
For m = 0 To UBound(GoodsInfos)
If GoodsInfos(m).Code = GoodsCodes(i) Then
lRet = lRet + BodyCounts(i) * GoodsInfos(m).Cost
Exit For
End If
Next m
If m > UBound(GoodsInfos) Then
Call DispLog("本体商品型番[" & GoodsCodes(i) & _
"]に該当するものが" & SHEET_NAME_DROPDOWN & "シートに見つかりません。")
GoTo SetupContractAmount_End
End If
Next i
Cells(row, COL_MISSION_LIST_SHEET_CONTRACT_AMOUNT).Value = lRet
SetupContractAmount_999:
SetupContractAmount = True
SetupContractAmount_End:
Exit Function
SetupContractAmount_Err:
MethodName = SHEET_NAME_MISSION_LIST & " SetupContractAmount"
Call DispErr(Err.Number, Err.Description)
Resume SetupContractAmount_End
End Function
～～～～～
’以下自分で追加・変数名を書き換えたコード
Private Function SetupContractAddUp(ByVal row As Long) As Boolean
Dim GoodsCodes() As String
Dim BodyCounts() As String
Dim str As String
Dim i As Long
Dim k As Long
Dim m As Long
Dim lRet As Long
SetupContractAddUp = False
On Error GoTo SetupContractAddUp_Err
If SplitCellValue(row, COL_MISSION_LIST_SHEET_GOODS_CODE, GoodsCodes) = False Then GoTo SetupContractAddUp_End
If SplitCellValue(row, COL_MISSION_LIST_SHEET_BODY_COUNT_CONTRACT, BodyCounts, True) = False Then GoTo SetupContractAddUp_End
' 商品型番の個数と台数の個数が一致しているかチェック
If Not Not GoodsCodes Then
Else
Call DispLog("本体商品型番が入力されていません。")
GoTo SetupContractAddUp_999
End If
If Not Not BodyCounts Then
Else
Call DispLog("本体台数が入力されていません。")
GoTo SetupContractAddUp_999
End If
If UBound(GoodsCodes) <> UBound(BodyCounts) Then
Call DispLog("本体商品型番[" & UBound(GoodsCodes) + 1 & _
"個]と本体台数[" & UBound(BodyCounts) + 1 & "個]の個数が一致していません。")
GoTo SetupContractAddUp_999
End If
' 計上金額算出
lRet = 0
Cells(row, COL_MISSION_LIST_SHEET_CONTRACT_ADD_UP).Value = lRet
For i = 0 To UBound(GoodsCodes)
For m = 0 To UBound(GoodsInfos)
If GoodsInfos(m).Code = GoodsCodes(i) Then
lRet = lRet + BodyCounts(i) * GoodsInfos(m).Cost
Exit For
End If
Next m
If m > UBound(GoodsInfos) Then
Call DispLog("本体商品型番[" & GoodsCodes(i) & _
"]に該当するものが" & SHEET_NAME_DROPDOWN & "シートに見つかりません。")
GoTo SetupContractAddUp_End
End If
Next i
Cells(row, COL_MISSION_LIST_SHEET_CONTRACT_ADD_UP).Value = lRet
SetupContractAddUp_999:
SetupContractAddUp = True
SetupContractAddUp_End:
Exit Function
SetupContractAddUp_Err:
MethodName = SHEET_NAME_MISSION_LIST & " SetupContractAddUp"
Call DispErr(Err.Number, Err.Description)
Resume SetupContractAddUp_End
End Function
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
回答じゃなく、純粋な疑問なんですが ＞受注台数を入力すると計上金額が自動で計算 は、計算式ではダメなんですか？ AE1=VLOOKUP(K1,Sheet2!商品品番・価格の列,2,0)*L1 てな具合で出せそうな気がしますけど。
もしよければ、下のコードで、現在の表がどうなっているのか教えていただけますか？
実行するとクリップボードに表っぽいのが保存されますので、あとはここに張り付けてもらえればOKです。
あまり広い範囲だとあれなんで、数サンプル分わかればＯＫです。
Sub ■説明用の表作成()
c = Split("A B C D E F G H I J K L M N O P Q R S T U V W X Y Z", " ")
rc = Split(Application.InputBox(prompt:="行-列の書式で作成したい表範囲を選択してください"), "-")
If Not UBound(rc, 1) = 1 Then Exit Sub
For i = 1 To rc(0)
Selection.Offset(i) = "[" & i & "]"
Next
For j = 1 To rc(1)
Selection.Offset(, j) = "[" & c(j - 1) & "]"
Next
End Sub
（稲葉） 2019/01/18(金) 18:46
すみません、↑のコード無視してください。 [[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか？』（ｍｏｍｏ） リンク先のコード使ってください。 （稲葉） 2019/01/18(金) 18:49
＞計算式ではダメなんですか？
毎日10行以上のデータが追加され複数人が触るので、表が崩れないように、できれば合計金額と同じようにマクロでやりたいなと思っていました。。
現在の表については、週明けに投稿させていただきます！
（ぽんくら） 2019/01/19(土) 00:43
＞表が崩れないように であれば、計算式にして、シートの保護をおすすめします
私は、その理由であればコード書きません
というか、作った人に問い合わせできないのですか？ （稲葉） 2019/01/19(土) 05:43
あと、一応教えていただいたコード実行してみましたが、列範囲が広くて表が崩れてしまったのでマクロに必要な列のみ手打ちしてみました。
N列とAF列が今回追加したい列です。
|[G] |[J] |[K] |[L] |[M] |[N] |[V] |[AB] |[AE] |[AF]
[5]|お客様|出荷予定 |型番 |台数履歴 |台数 |受注台数|販売店 |支社 |合計金額 |計上金額
[10]|A産業|2019年2月|商品A|2 |2 | |A社 |四国支社|\120,000 | [11]|D商店|2019年4月|商品B|25 |25 | |B社 |北陸支社|\3,000,000 | [12]|B商店|2019年1月|商品C|1 |1 | |B社 |関東支社|\10,000 | [13]|C食品|2019年2月|商品C|100 |100 | |C社 |東北支社|\1,000,000 |
（ぽんくら） 2019/01/21(月) 10:55
コード全部見てきましたけど、結局わかりません。
１）標準モジュールに書かれた変数を定義するコードがありませんが、 ThisWorkbookモジュールのWorkbook_Openイベントに何かありませんか？
２）Cells(row, COL_MISSION_LIST_SHEET_CONTRACT_AMOUNT).Value = lRet の部分でセルに書き込んでいますが、なぜFunctionモジュールで・・・？
３）lRet = lRet + BodyCounts(i) * GoodsInfos(m).Cost ここで書き込む金額を計算していますが、GoodsInfos(m)の配列がどこから引っ張って どのような値が入っているかわからないので、「どこを直す」の問いに答えようがありません。
４）Call DispErrのプロシージャを呼んでますが、どこにあるの？
表も見させてもらいましたけど、台数と受注台数の違い、合計金額と計上金額の違いが判りません。
私個人の感想ですが、今あるプログラムも全部破棄して、計算式で作り変えたほうがよっぽどいいと思います。
（稲葉） 2019/01/21(月) 12:24
Call DispErrについては、エラーのログが表示されるシート（シート名：ログ）があり、このエラーを自動表示するため、標準モジュール（Module2）に別にコードが組まれています。自動計算とは関係がないと思い、投稿しませんでした。重ね重ねすみません。念のため、ThisWorkbookモジュールのコードの下に記載します。
台数と受注台数の違い
→台数は受注予定の商品台数が入力され、受注台数は実際の受注数が入力されます。
合計金額と計上金額の違い
→合計金額は受注予定台数の商品金額合計です。計上金額は受注台数の合計金額です。
あと、最初の投稿で列情報が記載されているのはシート名：Sheet3と記載していましたが、正しくは”定数”
でした。
説明不足とコードの記載不足がありすみません、、、、
以下コードを記載いたします。
＜ThisWorkbook＞
Option Explicit
Private Sub Workbook_Open()
On Error GoTo Workbook_Open_Err
' ログ初期化
If InitLog = False Then GoTo Workbook_Open_Err
' Sheet2情報取り込み
If ConstSheetValueToConst() = False Then GoTo Workbook_Open_End
Workbook_Open_End:
Exit Sub
Workbook_Open_Err:
MethodName = "Workbook_Open"
Call DispErr(Err.Number, Err.Description)
GoTo Workbook_Open_End
End Sub
Private Function ConstSheetValueToConst() As Boolean
Dim row As Long, col As Long
Dim cellInfos As Variant
Dim i As Long
Dim m As Long
ConstSheetValueToConst = False
On Error GoTo ConstSheetValueToConst_Err
' 定数シート（元Sheet3）から取得
With ThisWorkbook.Worksheets(SHEET_NAME_CONST)
' Sheet1********************************************************
' シート名
FindName = "SHEET_NAME_MISSION_LIST"
row = .Cells.Find(What:=FindName, lookat:=xlWhole).row
col = .Cells.Find(What:=FindName, lookat:=xlWhole).Column
SHEET_NAME_MISSION_LIST = .Cells(row, col - 2).Value
' 明細開始行
FindName = "ROW_MISSION_LIST_SHEET_DETAIL_START"
row = .Cells.Find(What:=FindName, lookat:=xlWhole).row
col = .Cells.Find(What:=FindName, lookat:=xlWhole).Column
ROW_MISSION_LIST_SHEET_DETAIL_START = .Cells(row, col - 2).Value
' 本体商品型番
FindName = "COL_MISSION_LIST_SHEET_GOODS_CODE"
row = .Cells.Find(What:=FindName, lookat:=xlWhole).row
col = .Cells.Find(What:=FindName, lookat:=xlWhole).Column
COL_MISSION_LIST_SHEET_GOODS_CODE = .Cells(row, col - 2).Value
' 台数履歴
FindName = "COL_MISSION_LIST_SHEET_BODY_COUNT"
row = .Cells.Find(What:=FindName, lookat:=xlWhole).row
col = .Cells.Find(What:=FindName, lookat:=xlWhole).Column
COL_MISSION_LIST_SHEET_BODY_COUNT = .Cells(row, col - 2).Value
'受注台数 ←追加列（N）
FindName = "COL_MISSION_LIST_SHEET_BODY_COUNT_CONTRACT"
row = .Cells.Find(What:=FindName, lookat:=xlWhole).row
col = .Cells.Find(What:=FindName, lookat:=xlWhole).Column
COL_MISSION_LIST_SHEET_BODY_COUNT_CONTRACT = .Cells(row, col - 2).Value
' 合計金額
FindName = "COL_MISSION_LIST_SHEET_CONTRACT_AMOUNT"
row = .Cells.Find(What:=FindName, lookat:=xlWhole).row
col = .Cells.Find(What:=FindName, lookat:=xlWhole).Column
COL_MISSION_LIST_SHEET_CONTRACT_AMOUNT = .Cells(row, col - 2).Value
' 計上金額 ←追加列（AF）
FindName = "COL_MISSION_LIST_SHEET_CONTRACT_ADD_UP"
row = .Cells.Find(What:=FindName, lookat:=xlWhole).row
col = .Cells.Find(What:=FindName, lookat:=xlWhole).Column
COL_MISSION_LIST_SHEET_CONTRACT_ADD_UP = .Cells(row, col - 2).Value
' Sheet2 ********************************************************
' シート名
FindName = "SHEET_NAME_DROPDOWN"
row = .Cells.Find(What:=FindName, lookat:=xlWhole).row
col = .Cells.Find(What:=FindName, lookat:=xlWhole).Column
SHEET_NAME_DROPDOWN = .Cells(row, col - 2).Value
' 明細開始行
FindName = "ROW_DROPDOWN_SHEET_DETAIL_START"
row = .Cells.Find(What:=FindName, lookat:=xlWhole).row
col = .Cells.Find(What:=FindName, lookat:=xlWhole).Column
ROW_DROPDOWN_SHEET_DETAIL_START = .Cells(row, col - 2).Value
' 商品型番
FindName = "COL_DROPDOWN_SHEET_GOODS_CODE"
row = .Cells.Find(What:=FindName, lookat:=xlWhole).row
col = .Cells.Find(What:=FindName, lookat:=xlWhole).Column
COL_DROPDOWN_SHEET_GOODS_CODE = .Cells(row, col - 2).Value
' 商品金額
FindName = "COL_DROPDOWN_SHEET_COST"
row = .Cells.Find(What:=FindName, lookat:=xlWhole).row
col = .Cells.Find(What:=FindName, lookat:=xlWhole).Column
COL_DROPDOWN_SHEET_COST = .Cells(row, col - 2).Value
With ThisWorkbook.Worksheets(SHEET_NAME_DROPDOWN)
row = ROW_DROPDOWN_SHEET_DETAIL_START
Do
If .Cells(row, COL_DROPDOWN_SHEET_GOODS_CODE).Value = Empty Then Exit Do
If Not Not GoodsInfos Then
i = UBound(GoodsInfos) + 1
Else
i = 0
End If
ReDim Preserve GoodsInfos(i)
GoodsInfos(i).Code = .Cells(row, COL_DROPDOWN_SHEET_GOODS_CODE).Value
GoodsInfos(i).Cost = .Cells(row, COL_DROPDOWN_SHEET_COST).Value
row = row + 1
Loop
End With
End With
ConstSheetValueToConst = True
ConstSheetValueToConst_End:
Exit Function
ConstSheetValueToConst_Err:
MethodName = "ConstSheetValueToConst"
Call DispErrSetupConst(Err.Number, Err.Description)
GoTo ConstSheetValueToConst_End
End Function
エラー用コード
＜Module2＞
Option Explicit
Public FindName As String
Public MethodName As String
Public Const SHEET_NAME_LOG = "ログ"
Public LogRow As Long
' エラー表示
Public Sub DispErrMsg(ErrMsg As String)
MsgBox ErrMsg
Call DispLog(ErrMsg)
End Sub
' エラー表示
Public Sub DispErr(ErrNumber As Integer, ErrDescription As String)
Const ERR_MSG = "【%1】Error[%2」 %3"
Dim ErrMsg As String
ErrMsg = Replace(ERR_MSG, "%1", MethodName)
ErrMsg = Replace(ErrMsg, "%2", ErrNumber)
ErrMsg = Replace(ErrMsg, "%3", ErrDescription)
MsgBox ErrMsg: Call DispLog(ErrMsg)
End Sub
' 定数セットアップ_エラー表示
Public Sub DispErrSetupConst(ErrNumber As Integer, ErrDescription As String)
Const ERR_MSG_COL_NOT_FOUND = "【%1】定数シートに「%2」の値のセルがありません!!"
Dim ErrMsg As String
If ErrNumber = 91 Then ' Findで見つからない
ErrMsg = Replace(ERR_MSG_COL_NOT_FOUND, "%1", MethodName)
ErrMsg = Replace(ErrMsg, "%2", MethodName)
MsgBox ErrMsg: Call DispLog(ErrMsg)
Else
Call DispErr(ErrNumber, ErrDescription)
End If
End Sub
' ログ初期化
Public Function InitLog() As Boolean
Const ERR_MSG = "【%1】Error[%2」 %3"
Dim ErrMsg As String
InitLog = False
On Error GoTo InitLog_Err
With ThisWorkbook.Worksheets(SHEET_NAME_LOG)
.Cells.Clear
End With
LogRow = 0
InitLog = True
InitLog_End:
Exit Function
InitLog_Err:
MethodName = "InitLog"
Call DispErr(Err.Number, Err.Description)
Resume InitLog_End
End Function
' ログ表示
Public Function DispLog(log As String) As Boolean
DispLog = False
' On Error GoTo DispLog_Err
With ThisWorkbook.Worksheets(SHEET_NAME_LOG)
LogRow = LogRow + 1
.Cells(LogRow, 1).Value = log
End With
DispLog = True
DispLog_End:
Exit Function
'DispLog_Err:
' MethodName = "DispLog"
' Call DispErr(Err.Number, Err.Description)
' Resume DispLog_End
End Function
（ぽんくら） 2019/01/21(月) 14:34
＜ThisWorkbook＞にも追加列分のコードを追加したところ、AF列（計上金額）が自動計算されるようになったのですが、N列（受注台数）への入力だけでは実行されず、L列（台数履歴）の台数の入力しなおしもしないと自動計算がされませんでした。
他にどこを書き換えれば良いのかわからない状況です、、
（ぽんくら） 2019/01/21(月) 14:43
載せるだけじゃなくて自分で内容理解して説明してくれません？
イベントの実行はシートモジュールにある
＞Private Sub Worksheet_Change(ByVal Target As Range)
で行っています。
その範囲の判断は
＞Select Case col
～～～
なので、新しい分岐を作って、その中に入れてください。
回りくどい変数とか作るの面倒なので、
Case Range("N1").Column
で十分だと思います。
以下愚痴。
＞ FindName = "SHEET_NAME_MISSION_LIST" ＞ row = .Cells.Find(What:=FindName, lookat:=xlWhole).row ＞ col = .Cells.Find(What:=FindName, lookat:=xlWhole).Column ＞ SHEET_NAME_MISSION_LIST = .Cells(row, col - 2).Value 定数シートから、語句を探し出しているだけですよね？ これ見て、どんな表になっているか回答者に想像（いっそ創造）させるのが趣旨なんですか？
しかもこんなん1行で書けよ。 SHEET_NAME_MISSION_LIST = .Cells.Find(What:="SHEET_NAME_MISSION_LIST", lookat:=xlWhole).Offset(,-2).Value
ThisWOrkbookのエラーを専用なのに、標準モジュールに飛ばしてる意味も分からんし。
前回申した通りです。 ＞ 私個人の感想ですが、今あるプログラムも全部破棄して、計算式で作り変えたほうがよっぽどいいと思います。
以降、プログラムを直す作業はしません。 （稲葉） 2019/01/21(月) 15:13
また、理解できないまま長々とコードを記載してしまい申し訳ありません。。。
今後このような迷惑をかけないようもっと勉強しようと思います。
丸投げの形になってしまったにも関わらず最後までお付き合いいただきありがとうございました！
（ぽんくら） 2019/01/21(月) 15:55
＞今後このような迷惑をかけないようもっと勉強しようと思います。 いや、これはコードの進行がよろしくない。 読みたくなくなる気持ちもすごくよくわかる。
具体的な表と、目的とした動作さえ教えてもらえれば、もっとシンプルに作り変えます。
提示いただいたコードは、いわゆるスパゲッティプログラムといっても、たぶんいいと思います。 https://ja.wikipedia.org/wiki/%E3%82%B9%E3%83%91%E3%82%B2%E3%83%86%E3%82%A3%E3%83%97%E3%83%AD%E3%82%B0%E3%83%A9%E3%83%A0
Wikiさんの特徴を大体包含した素晴らしいスパゲッティです。
例を挙げます。
１）goto文の濫用
On Error GoTo Worksheet_Change_Err
'（省略）
'★エラー発生！
'（a）へ飛ぶ
'エラーが無かったら、（b）が処理され、終了する
Worksheet_Change_End:
'●（b）
Exit Sub
Worksheet_Change_Err:
'●（a）
MethodName = SHEET_NAME_MISSION_LIST & " Worksheet_Change"
Call DispErr(Err.Number, Err.Description)
Resume Worksheet_Change_End
'エラーを表示させて、（b）へ飛ぶ
エラー出たらその場で止めときゃええやん。 やってることはメッセージ表示させてるだけだし、イベントの制御もしてないんだから、いらないでしょ。 むしろエラーが出る場所を想定できないコードがおかしい。
２）スコープの拡大 標準モジュールにPublicがたくさんありますけど、いらないですよね？ １）を例に挙げると、MethodNameはModule2にありますが、どこでどう宣言されたのかわからないので、 探しに行かないといけませんよね？ で、使われ方はDispErrのメッセージ表示のみ。 だったら、次のようにDispErrの引数として渡せばええやん。 Call DispErr(Err.Number, Err.Description, SHEET_NAME_MISSION_LIST & " Worksheet_Change" )
他にもツッコミどころあるけど、今後も使い続けるなら、マクロなんか使わず、計算式でやったほうが 絶対いいですよ。
（稲葉） 2019/01/21(月) 16:42
自分でいじったりしながら（コピペだけですが）エラーの部分は全く理解できていませんでした。
不要な部分も多数あったのですね。他の方が書いたものだから今回必要な部分だけ変えれればいいや、というような心境でしたので、自分で調べるのを怠っていました。
それでもかなり簡単なところ（＞Select Case col の部分に追加すればよかっただけ）でコードを誤っており、稲葉さんに教えていただくまで気づけませんでした。自分でも反省しています。。すみません。
まだまだ理解できていない部分のほうが多いので、稲葉さんに教えていただいたことを参考にしながら少しずつ自分で見やすいように書き換えていきたいと思います！
それと、一度計算式でもやってみましたがそちらのほうがはるかに簡単でしたし、表が崩れるといった心配にも無縁に感じました。今後も使い続けていくファイルなので計算式での運用についても検討しようと思います。
本当にありがとうございます。おかげで早く問題解決できました！（；V；）
（ぽんくら） 2019/01/21(月) 17:06
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.