[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『プログラムコードをコンパクトにする方法』（超初心者）
Excelを取り込み、その中のデータを条件分岐をかけて回していくのですg
ひとずつ記載していくと、容量をおーばとしてエラーが出てしまいます。
何かまとめる方法は、あるのでしょうか
Sub 取込み_Click()
Dim filePath As String
Dim wb1 As Workbook
Dim ws1, ws2, ws3, ws4, ws5 As Worksheet
Dim i, j, k, n As Long
Set ws2 = ThisWorkbook.Worksheets("1")
Set ws3 = ThisWorkbook.Worksheets("2")
Set ws4 = ThisWorkbook.Worksheets("3")
Set ws5 = ThisWorkbook.Worksheets("4")
ws2.Range("C5:P118").ClearContents
ChDir ThisWorkbook.Path
filePath = Application.GetOpenFilename(FileFilter:=".xlsファイル(*.xls),*.xls", Title:=".xlsファイルの選択")
If filePath = "False" Then
MsgBox "ファイルが選択されなかったので処理を中止します。"
Exit Sub
Else
Set wb1 = Workbooks.Open(filePath)
Set ws1 = wb1.Worksheets(1)
End If
For i = 2 To ws1.Cells(Rows.Count, "B").End(xlUp).Row
If ws1.Cells(i, "C") = "鉄道事業" Then
If ws1.Cells(i, "I") = "旅客運輸収入-定期外-運賃" Then
ws2.Cells(5, "C") = ws1.Cells(i, "J") '旅客運輸収入-定期外-運賃
ElseIf ws1.Cells(i, "I") = "旅客運輸収入-定期外-料金" Then
ws2.Cells(6, "C") = ws1.Cells(i, "J") '旅客運輸収入-定期外-料金
ElseIf ws1.Cells(i, "I") = "旅客運輸収入-定期-運賃" Then
ws2.Cells(8, "C") = ws1.Cells(i, "J") '旅客運輸収入-定期-運賃
ElseIf ws1.Cells(i, "I") = "旅客運輸収入-定期-料金" Then
ws2.Cells(9, "C") = ws1.Cells(i, "J") '旅客運輸収入-定期-料金
ElseIf ws1.Cells(i, "I") = "運輸雑収-鉄道広告料-駅貼ﾎﾟｽﾀｰ" Then
ws2.Cells(12, "C") = ws1.Cells(i, "J") '運輸雑収-鉄道広告料-駅貼ﾎﾟｽﾀｰ
ElseIf ws1.Cells(i, "I") = "運輸雑収-鉄道広告料-車内ﾎﾟｽﾀｰ" Then
ws2.Cells(13, "C") = ws1.Cells(i, "J") '運輸雑収-鉄道広告料-車内ﾎﾟｽﾀｰ
ElseIf ws1.Cells(i, "I") = "運輸雑収-鉄道広告料-雑入" Then
ws2.Cells(14, "C") = ws1.Cells(i, "J") '運輸雑収-鉄道広告料-雑入
ElseIf ws1.Cells(i, "I") = "運輸雑収-鉄道土地物件貸付料" Then
ws2.Cells(16, "C") = ws1.Cells(i, "J") '運輸雑収-鉄道土地物件貸付料
ElseIf ws1.Cells(i, "I") = "運輸雑収-その他-駅共同使用料" Then
ws2.Cells(17, "C") = ws1.Cells(i, "J") '運輸雑収-その他-駅共同使用料
ElseIf ws1.Cells(i, "I") = "運輸雑収-その他-構内営業料" Then
ws2.Cells(18, "C") = ws1.Cells(i, "J") '運輸雑収-その他-構内営業料
ElseIf ws1.Cells(i, "I") = "運輸雑収-その他-旅客雑入" Then
ws2.Cells(19, "C") = ws1.Cells(i, "J") '運輸雑収-その他-旅客雑入
ElseIf ws1.Cells(i, "I") = "運輸雑収-その他-厚生福利施設収入(配賦後)" Then
ws2.Cells(20, "C") = ws1.Cells(i, "J") '運輸雑収-その他-厚生福利施設収入(配賦後)
ElseIf ws1.Cells(i, "I") = "運輸雑収-その他-雑入" Then
ws2.Cells(21, "C") = ws1.Cells(i, "J") '運輸雑収-その他-雑入
ElseIf ws1.Cells(i, "I") = "運輸雑収-その他-雑入-工事負担金収入" Then
ws2.Cells(22, "C") = ws1.Cells(i, "J") '運輸雑収-その他-雑入-工事負担金収入
ElseIf ws1.Cells(i, "E") = "鉄道(南海線)-線路保存費" Then
If ws1.Cells(i, "I") = "役員報酬" Then '役員報酬
ws2.Cells(25, "D") = ws1.Cells(i, "J") '役員報酬
ElseIf ws1.Cells(i, "I") = "給料" Then '給料料
ws2.Cells(26, "D") = ws1.Cells(i, "J") '給料
ElseIf ws1.Cells(i, "I") = "手当" Then
ws2.Cells(27, "D") = ws1.Cells(i, "J") '手当
ElseIf ws1.Cells(i, "I") = "賞与-一般賞与" Then
ws2.Cells(28, "D") = ws1.Cells(i, "J") '賞与-一般賞与
ElseIf ws1.Cells(i, "I") = "賞与-臨時給" Then
ws2.Cells(29, "D") = ws1.Cells(i, "J") '賞与-臨時給
ElseIf ws1.Cells(i, "I") = "臨時雇賃金" Then
ws2.Cells(30, "D") = ws1.Cells(i, "J") '臨時雇賃金
ElseIf ws1.Cells(i, "I") = "退職金-退職給付費用(会社支給分)" Then
ws2.Cells(31, "D") = ws1.Cells(i, "J") '退職金-退職給付費用(会社支給分)
ElseIf ws1.Cells(i, "I") = "退職金-退職給付費用(年金支給分)" Then
ws2.Cells(32, "D") = ws1.Cells(i, "J") '退職金-退職給付費用(年金支給分)
ElseIf ws1.Cells(i, "I") = "退職金-その他" Then
ws2.Cells(33, "D") = ws1.Cells(i, "J") '退職金-その他
ElseIf ws1.Cells(i, "I") = "厚生費-法定福利費(健康保険ほか)" Then
ws2.Cells(35, "D") = ws1.Cells(i, "J") '厚生費-法定福利費(健康保険ほか)
ElseIf ws1.Cells(i, "I") = "厚生費-厚生福利費" Then
ws2.Cells(36, "D") = ws1.Cells(i, "J") '厚生費-厚生福利費
ElseIf ws1.Cells(i, "I") = "修繕費-材料費-取替材料費" Then
ws2.Cells(40, "D") = ws1.Cells(i, "J") '修繕費-材料費-取替材料費
ElseIf ws1.Cells(i, "I") = "修繕費-材料費-普通材料費" Then
ws2.Cells(41, "D") = ws1.Cells(i, "J") '修繕費-材料費-普通材料費
ElseIf ws1.Cells(i, "I") = "修繕費-外注費-取替外注費" Then
ws2.Cells(43, "D") = ws1.Cells(i, "J") '修繕費-外注費-取替外注費
ElseIf ws1.Cells(i, "I") = "修繕費-外注費-普通外注費" Then
ws2.Cells(44, "D") = ws1.Cells(i, "J") '修繕費-外注費-普通外注費
ElseIf ws1.Cells(i, "I") = "物件費-備消品費-備消品費" Then
ws2.Cells(50, "D") = ws1.Cells(i, "J") '物件費-備消品費-備消品費
ElseIf ws1.Cells(i, "I") = "物件費-備消品費-建仮振替備消品費" Then
ws2.Cells(51, "D") = ws1.Cells(i, "J") '物件費-備消品費-建仮振替備消品費
ElseIf ws1.Cells(i, "I") = "物件費-備消品費-少額資産(10万円以上20万円未満)" Then
ws2.Cells(52, "D") = ws1.Cells(i, "J") '物件費-備消品費-少額資産(10万円以上20万円未満)
ElseIf ws1.Cells(i, "I") = "物件費-被服費" Then
ws2.Cells(54, "D") = ws1.Cells(i, "J") '物件費-被服費
ElseIf ws1.Cells(i, "I") = "物件費-水道光熱費-水道料" Then
ws2.Cells(55, "D") = ws1.Cells(i, "J") '物件費-水道光熱費-水道料
ElseIf ws1.Cells(i, "I") = "物件費-水道光熱費-電気料" Then
ws2.Cells(56, "D") = ws1.Cells(i, "J") '物件費-水道光熱費-電気料
ElseIf ws1.Cells(i, "I") = "物件費-水道光熱費-ｶﾞｽ料" Then
ws2.Cells(57, "D") = ws1.Cells(i, "J") '物件費-水道光熱費-ｶﾞｽ料
ElseIf ws1.Cells(i, "I") = "その他経費-諸手数料" Then
ws2.Cells(71, "D") = ws1.Cells(i, "J") 'その他経費-諸手数料
ElseIf ws1.Cells(i, "I") = "その他経費-委託料-委託料" Then
ws2.Cells(75, "D") = ws1.Cells(i, "J") 'その他経費-委託料-委託料
ElseIf ws1.Cells(i, "I") = "その他経費-旅費" Then
ws2.Cells(78, "D") = ws1.Cells(i, "J") 'その他経費-旅費
ElseIf ws1.Cells(i, "I") = "その他経費-交通費-交通費" Then
ws2.Cells(79, "D") = ws1.Cells(i, "J") 'その他経費-交通費-交通費
ElseIf ws1.Cells(i, "I") = "その他経費-交通費-通勤定期代" Then
ws2.Cells(80, "D") = ws1.Cells(i, "J") 'その他経費-交通費-通勤定期代
ElseIf ws1.Cells(i, "I") = "その他経費-通信運搬費-通信費" Then
ws2.Cells(82, "D") = ws1.Cells(i, "J") 'その他経費-通信運搬費-通信費
ElseIf ws1.Cells(i, "I") = "その他経費-通信運搬費-運搬費" Then
ws2.Cells(83, "D") = ws1.Cells(i, "J") 'その他経費-通信運搬費-運搬費
ElseIf ws1.Cells(i, "I") = "(不使用)その他経費-通信運搬費-その他" Then
ws2.Cells(84, "D") = ws1.Cells(i, "J") '(不使用)その他経費-通信運搬費-その他
ElseIf ws1.Cells(i, "I") = "その他経費-清掃料" Then
ws2.Cells(93, "D") = ws1.Cells(i, "J") 'その他経費-清掃料
ElseIf ws1.Cells(i, "I") = "その他経費-警備料" Then
ws2.Cells(94, "D") = ws1.Cells(i, "J") 'その他経費-警備料
ElseIf ws1.Cells(i, "I") = "その他経費-雑費-諸費" Then
ws2.Cells(95, "D") = ws1.Cells(i, "J") 'その他経費-雑費-諸費
ElseIf ws1.Cells(i, "I") = "その他経費-固定資産除却費-撤去費" Then
ws2.Cells(98, "D") = ws1.Cells(i, "J") 'その他経費-固定資産除却費-撤去費
ElseIf ws1.Cells(i, "I") = "その他経費-固定資産除却費-除却費" Then
ws2.Cells(99, "D") = ws1.Cells(i, "J") 'その他経費-固定資産除却費-除却費
End If
ElseIf ws1.Cells(i, "E") = "鉄道(南海線)-電路保存費" Then
If ws1.Cells(i, "I") = "役員報酬" Then '役員報酬
ws2.Cells(25, "E") = ws1.Cells(i, "J") '役員報酬
ElseIf ws1.Cells(i, "I") = "給料" Then '給料料
ws2.Cells(26, "E") = ws1.Cells(i, "J") '給料
ElseIf ws1.Cells(i, "I") = "手当" Then
ws2.Cells(27, "E") = ws1.Cells(i, "J") '手当
ElseIf ws1.Cells(i, "I") = "賞与-一般賞与" Then
ws2.Cells(28, "E") = ws1.Cells(i, "J") '賞与-一般賞与
ElseIf ws1.Cells(i, "I") = "賞与-臨時給" Then
ws2.Cells(29, "E") = ws1.Cells(i, "J") '賞与-臨時給
ElseIf ws1.Cells(i, "I") = "臨時雇賃金" Then
ws2.Cells(30, "E") = ws1.Cells(i, "J") '臨時雇賃金
ElseIf ws1.Cells(i, "I") = "退職金-退職給付費用(会社支給分)" Then
ws2.Cells(31, "E") = ws1.Cells(i, "J") '退職金-退職給付費用(会社支給分)
ElseIf ws1.Cells(i, "I") = "退職金-退職給付費用(年金支給分)" Then
ws2.Cells(32, "E") = ws1.Cells(i, "J") '退職金-退職給付費用(年金支給分)
ElseIf ws1.Cells(i, "I") = "退職金-その他" Then
ws2.Cells(33, "E") = ws1.Cells(i, "J") '退職金-その他
ElseIf ws1.Cells(i, "I") = "厚生費-法定福利費(健康保険ほか)" Then
ws2.Cells(35, "E") = ws1.Cells(i, "J") '厚生費-法定福利費(健康保険ほか)
ElseIf ws1.Cells(i, "I") = "厚生費-厚生福利費" Then
ws2.Cells(36, "E") = ws1.Cells(i, "J") '厚生費-厚生福利費
ElseIf ws1.Cells(i, "I") = "修繕費-材料費-取替材料費" Then
ws2.Cells(40, "E") = ws1.Cells(i, "J") '修繕費-材料費-取替材料費
ElseIf ws1.Cells(i, "I") = "修繕費-材料費-普通材料費" Then
ws2.Cells(41, "E") = ws1.Cells(i, "J") '修繕費-材料費-普通材料費
ElseIf ws1.Cells(i, "I") = "修繕費-外注費-取替外注費" Then
ws2.Cells(43, "E") = ws1.Cells(i, "J") '修繕費-外注費-取替外注費
ElseIf ws1.Cells(i, "I") = "修繕費-外注費-普通外注費" Then
ws2.Cells(44, "E") = ws1.Cells(i, "J") '修繕費-外注費-普通外注費
ElseIf ws1.Cells(i, "I") = "物件費-備消品費-備消品費" Then
ws2.Cells(50, "E") = ws1.Cells(i, "J") '物件費-備消品費-備消品費
ElseIf ws1.Cells(i, "I") = "物件費-備消品費-建仮振替備消品費" Then
ws2.Cells(51, "E") = ws1.Cells(i, "J") '物件費-備消品費-建仮振替備消品費
ElseIf ws1.Cells(i, "I") = "物件費-備消品費-少額資産(10万円以上20万円未満)" Then
ws2.Cells(52, "E") = ws1.Cells(i, "J") '物件費-備消品費-少額資産(10万円以上20万円未満)
ElseIf ws1.Cells(i, "I") = "物件費-被服費" Then
ws2.Cells(54, "E") = ws1.Cells(i, "J") '物件費-被服費
ElseIf ws1.Cells(i, "I") = "物件費-水道光熱費-水道料" Then
ws2.Cells(55, "E") = ws1.Cells(i, "J") '物件費-水道光熱費-水道料
ElseIf ws1.Cells(i, "I") = "物件費-水道光熱費-電気料" Then
ws2.Cells(56, "E") = ws1.Cells(i, "J") '物件費-水道光熱費-電気料
ElseIf ws1.Cells(i, "I") = "物件費-水道光熱費-ｶﾞｽ料" Then
ws2.Cells(57, "E") = ws1.Cells(i, "J") '物件費-水道光熱費-ｶﾞｽ料
ElseIf ws1.Cells(i, "I") = "物件費-水道光熱費-その他" Then
ws2.Cells(58, "E") = ws1.Cells(i, "J") '物件費-水道光熱費-その他
ElseIf ws1.Cells(i, "I") = "その他経費-諸手数料" Then
ws2.Cells(71, "E") = ws1.Cells(i, "J") 'その他経費-諸手数料
ElseIf ws1.Cells(i, "I") = "その他経費-委託料-委託料" Then
ws2.Cells(75, "E") = ws1.Cells(i, "J") 'その他経費-委託料-委託料
ElseIf ws1.Cells(i, "I") = "その他経費-旅費" Then
ws2.Cells(78, "E") = ws1.Cells(i, "J") 'その他経費-旅費
ElseIf ws1.Cells(i, "I") = "その他経費-交通費-交通費" Then
ws2.Cells(79, "E") = ws1.Cells(i, "J") 'その他経費-交通費-交通費
ElseIf ws1.Cells(i, "I") = "その他経費-交通費-通勤定期代" Then
ws2.Cells(80, "E") = ws1.Cells(i, "J") 'その他経費-交通費-通勤定期代
ElseIf ws1.Cells(i, "I") = "その他経費-通信運搬費-通信費" Then
ws2.Cells(82, "E") = ws1.Cells(i, "J") 'その他経費-通信運搬費-通信費
ElseIf ws1.Cells(i, "I") = "その他経費-通信運搬費-運搬費" Then
ws2.Cells(83, "E") = ws1.Cells(i, "J") 'その他経費-通信運搬費-運搬費
ElseIf ws1.Cells(i, "I") = "(不使用)その他経費-通信運搬費-その他" Then
ws2.Cells(84, "E") = ws1.Cells(i, "J") '(不使用)その他経費-通信運搬費-その他
ElseIf ws1.Cells(i, "I") = "その他経費-清掃料" Then
ws2.Cells(93, "E") = ws1.Cells(i, "J") 'その他経費-清掃料
ElseIf ws1.Cells(i, "I") = "その他経費-警備料" Then
ws2.Cells(94, "E") = ws1.Cells(i, "J") 'その他経費-警備料
ElseIf ws1.Cells(i, "I") = "その他経費-雑費-諸費" Then
ws2.Cells(95, "E") = ws1.Cells(i, "J") 'その他経費-雑費-諸費
ElseIf ws1.Cells(i, "I") = "その他経費-固定資産除却費-撤去費" Then
ws2.Cells(98, "E") = ws1.Cells(i, "J") 'その他経費-固定資産除却費-撤去費
ElseIf ws1.Cells(i, "I") = "その他経費-固定資産除却費-除却費" Then
ws2.Cells(99, "E") = ws1.Cells(i, "J") 'その他経費-固定資産除却費-除却費
End If
End If
End If
End If
Next i
ws2.Cells(7, "C") = ws2.Cells(5, "C") + ws2.Cells(6, "C") '定期外収入
ws2.Cells(10, "C") = ws2.Cells(8, "C") + ws2.Cells(9, "C") '定期収入
ws2.Cells(11, "C") = ws2.Cells(7, "C") + ws2.Cells(10, "C") '旅客運輸収入
ws2.Cells(15, "C") = ws2.Cells(12, "C") + ws2.Cells(13, "C") + ws2.Cells(14, "C") '運輸雑収-鉄道広告料収入
ws2.Cells(23, "C") = ws2.Cells(15, "C") + ws2.Cells(16, "C") + ws2.Cells(17, "C") + ws2.Cells(18, "C") + ws2.Cells(19, "C") + ws2.Cells(20, "C") + ws2.Cells(21, "C") + ws2.Cells(22, "C") '運輸雑収
ws2.Cells(24, "C") = ws2.Cells(11, "C") + ws2.Cells(15, "C") + ws2.Cells(16, "C") + ws2.Cells(17, "C") + ws2.Cells(18, "C") + ws2.Cells(19, "C") + ws2.Cells(20, "C") + ws2.Cells(21, "C") + ws2.Cells(22, "C") '■ 営業収益 ■
ws2.Cells(34, "D") = ws2.Cells(31, "D") + ws2.Cells(32, "D") + ws2.Cells(33, "D") '退職金
ws2.Cells(37, "D") = ws2.Cells(35, "D") + ws2.Cells(36, "D") '厚生費
ws2.Cells(38, "D") = ws2.Cells(25, "D") + ws2.Cells(26, "D") + ws2.Cells(27, "D") + ws2.Cells(28, "D") + ws2.Cells(29, "D") + ws2.Cells(30, "D") + ws2.Cells(34, "D") + ws2.Cells(37, "D") '人件費
ws2.Cells(42, "D") = ws2.Cells(40, "D") + ws2.Cells(41, "D") '材料費
ws2.Cells(45, "D") = ws2.Cells(43, "D") + ws2.Cells(44, "D") '外注費
ws2.Cells(46, "D") = ws2.Cells(42, "D") + ws2.Cells(45, "D") '修繕費
ws2.Cells(53, "D") = ws2.Cells(50, "D") + ws2.Cells(51, "D") + ws2.Cells(52, "D") '備消品費
ws2.Cells(59, "D") = ws2.Cells(55, "D") + ws2.Cells(56, "D") + ws2.Cells(57, "D") + ws2.Cells(58, "D") '水道光熱費
ws2.Cells(61, "D") = ws2.Cells(53, "D") + ws2.Cells(54, "D") + ws2.Cells(59, "D") '物件費
ws2.Cells(81, "D") = ws2.Cells(78, "D") + ws2.Cells(79, "D") + ws2.Cells(80, "D") '旅費交通費
ws2.Cells(85, "D") = ws2.Cells(82, "D") + ws2.Cells(83, "D") + ws2.Cells(84, "D") '通信運搬費
ws2.Cells(100, "D") = ws2.Cells(98, "D") + ws2.Cells(99, "D") '固定資産税除却費
ws2.Cells(101, "D") = ws2.Cells(69, "D") + ws2.Cells(70, "D") + ws2.Cells(71, "D") + ws2.Cells(75, "D") + ws2.Cells(76, "D") + ws2.Cells(77, "D") + ws2.Cells(81, "D") + ws2.Cells(85, "D") + ws2.Cells(86, "D") + ws2.Cells(90, "D") + ws2.Cells(91, "D") + ws2.Cells(92, "D") + ws2.Cells(93, "D") + ws2.Cells(94, "D") + ws2.Cells(95, "D") + ws2.Cells(96, "D") + ws2.Cells(97, "D") + ws2.Cells(100, "D") 'その他経費
ws2.Cells(118, "D") = ws2.Cells(38, "D") + ws2.Cells(46, "D") + ws2.Cells(61, "D") + ws2.Cells(101, "D") '■ 営業費用 ■
Application.DisplayAlerts = False
wb1.Close
Application.DisplayAlerts = True
ws2.Select
End Sub
＜ 使用 Excel：unknown、使用 OS：unknown ＞
>何かまとめる方法は、あるのでしょうか
これだけ条件分岐するんでしたら、ワークシートに条件表を作成して、それを参照すればいいんじゃないでしょうか。
すべてコードにすると、メンテナンスが大変だと思います。
あと、Select Caseを調べてみてください。
（フォーキー） 2023/02/17(金) 00:32:54
提示されたコードを見ると、End If がひとつ余分だし、 論理構造がちょっと怪しくないですか？ まあそれはよく検証してもらうことにして、とりあえず置くとして、 皆さんからの提案を例で示すと、以下のようなことでしょう。
(1)Select Case ステートメントの使用
例文の一部を書き換えてみると、こんなイメージになる。
For i = 2 To ws1.Cells(Rows.Count, "B").End(xlUp).Row
s = ws1.Cells(i, "J")
If ws1.Cells(i, "C") = "鉄道事業" Then
Select Case ws1.Cells(i, "I")
Case "旅客運輸収入-定期外-運賃": k = 5
Case "旅客運輸収入-定期外-料金": k = 6
Case "旅客運輸収入-定期-運賃": k = 8
Case "旅客運輸収入-定期-料金": k = 9
Case "運輸雑収-鉄道広告料-駅貼ﾎﾟｽﾀｰ": k = 12
Case "運輸雑収-鉄道広告料-車内ﾎﾟｽﾀｰ": k = 13
Case "運輸雑収-鉄道広告料-雑入": k = 14
Case "運輸雑収-鉄道土地物件貸付料": k = 16
Case "運輸雑収-その他-駅共同使用料": k = 17
Case "運輸雑収-その他-構内営業料": k = 18
Case "運輸雑収-その他-旅客雑入": k = 19
Case "運輸雑収-その他-厚生福利施設収入(配賦後)": k = 20
Case "運輸雑収-その他-雑入": k = 21
Case "運輸雑収-その他-雑入-工事負担金収入": k = 22
End Select
ws2.Cells(k, "C") = s
(2)ワークシート上に対応関係の表を作り、これを利用する方法。 上の、項目と番号の対応関係を表にして、以下のように使う。
myTable1 = Worksheets("対応表").Range("A1:B50").Value
For i = 2 To ws1.Cells(Rows.Count, "B").End(xlUp).Row
s = ws1.Cells(i, "J")
If ws1.Cells(i, "C") = "鉄道事業" Then
k = Application.VLookup(ws1.Cells(i, "I"), myTable1, 2, False)
ws2.Cells(k, "C") = s
End If
上では、myTable1という配列にしてみたが、もちろん、ワークシートの表を 直接参照してもよいでしょう。（速度を気にしなければ。実際差はさほど無いかも）
（abc） 2023/02/17(金) 06:30:01
"営業費用テーブル"シートを以下の感じで作って
|_A_, _B_, _C_, _D_, _E_, _F_, _G_, _H_, _I_, _J_, _K_, _L_, _M_, _N_, _O_, _P_, _Q_, _R_, _S_, _T_ 1 | 3, 7, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 定期外収入 2 | 3, 10, 8, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 定期収入 3 | 3, 11, 7, 10, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 旅客運輸収入 4 | 3, 15, 12, 13, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 , 0, 0, 0, 0 ' 運輸雑収-鉄道広告料収入 5 | 3, 23, 15, 16, 17, 18, 19, 20, 21, 22, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 運輸雑収 6 | 3, 24, 11, 15, 16, 17, 18, 19, 20, 21, 22, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' ■ 営業収益 ■ 7 | 4, 34, 31, 32, 33, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 退職金 8 | 4, 37, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 厚生費 9 | 4, 38, 25, 26, 27, 28, 29, 30, 34, 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 人件費 10 | 4, 42, 40, 41, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 材料費 11 | 4, 45, 43, 44, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 外注費 12 | 4, 46, 42, 45, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 修繕費 13 | 4, 53, 50, 51, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 備消品費 14 | 4, 59, 55, 56, 57, 58, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 水道光熱費 15 | 4, 61, 53, 54, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 物件費 16 | 4, 81, 78, 79, 80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 旅費交通費 17 | 4, 85, 82, 83, 84, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 通信運搬費 18 | 4, 100, 98, 99, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' 固定資産税除却費 19 | 4, 101, 69, 70, 71, 75, 76, 77, 81, 85, 86, 90, 91, 92, 93, 94, 95, 96, 97, 100 ' その他経費 20 | 4, 118, 38, 46, 61, 101, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 , 0, 0 ' ■ 営業費用 ■
ws2.cells(.cells( i, 1), .cells(i, 2)) = 0
for j = 3 to 20
with ws3
ws2.cells(.cells(i, 2), .cells(i, 1)) = ws2.cells(.cells(i, 2), .cells(i, 1)) + iif(.cells(i, j) > 0, .cells(i, j), 0)
end with
next
next
だいぶすっきりすると思います
（たつ） 2023/02/17(金) 11:16:07
Sub Sample()
Dim filePath As String
Dim wb1 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim cDic As Object, rDic As Object, aDic As Object
Dim cBuf As Variant, rBuf As Variant, aBuf As Variant
Dim i As Long
Set ws2 = ThisWorkbook.Worksheets("1")
ChDir ThisWorkbook.Path
filePath = Application.GetOpenFilename(FileFilter:=".xlsファイル(*.xls),*.xls", Title:=".xlsファイルの選択")
If filePath = "False" Then
MsgBox "ファイルが選択されなかったので処理を中止します。"
Exit Sub
Else
Set wb1 = Workbooks.Open(filePath)
Set ws1 = wb1.Worksheets(1)
End If
Set cDic = SampleDic(1) Set rDic = SampleDic(2) Set aDic = SampleDic(3)
ws2.Range("C5:P118").ClearContents
For i = 2 To ws1.Cells(Rows.Count, "B").End(xlUp).Row
cBuf = ws1.Cells(i, "C").Value
rBuf = ws1.Cells(i, "I").Value
If cDic.exists(cBuf) And rDic.exists(rBuf) Then
ws2.Cells(CLng(rDic(rBuf)), CLng(cDic(cBuf))).Value = ws1.Cells(i, "J").Value
End If
Next i
For Each aBuf In aDic
With ws2.Range(aBuf)
.Value = aDic(aBuf)
.Value = .Value
End With
Next aBuf
Application.DisplayAlerts = False wb1.Close Application.DisplayAlerts = True ws2.Select End Sub
Private Function SampleDic(arg) As Object
Dim v
Dim d As String
Select Case arg
Case 1
d = ","
v = Array("鉄道事業,3", "鉄道(南海線)-線路保存費,4", "鉄道(南海線)-電路保存費,5")
Case 2
d = ","
v = Array("旅客運輸収入-定期外-運賃,5", "旅客運輸収入-定期外-料金,6", "旅客運輸収入-定期-運賃,8", _
"旅客運輸収入-定期-料金,9", "運輸雑収-鉄道広告料-駅貼ﾎﾟｽﾀｰ,12", "運輸雑収-鉄道広告料-車内ﾎﾟｽﾀｰ,13", _
"運輸雑収-鉄道広告料-雑入,14", "運輸雑収-鉄道土地物件貸付料,16", "運輸雑収-その他-駅共同使用料,17", _
"運輸雑収-その他-構内営業料,18", "運輸雑収-その他-旅客雑入,19", "運輸雑収-その他-厚生福利施設収入(配賦後),20", _
"運輸雑収-その他-雑入,21", "運輸雑収-その他-雑入-工事負担金収入,22", _
"役員報酬,25", "給料,26", "手当,27", "賞与-一般賞与,28", "賞与-臨時給,29", "臨時雇賃金,30", _
"退職金-退職給付費用(会社支給分),31", "退職金-退職給付費用(年金支給分),32", _
"退職金-その他,33", "厚生費-法定福利費(健康保険ほか),35", "厚生費-厚生福利費,36", _
"修繕費-材料費-取替材料費,40", "修繕費-材料費-普通材料費,41", "修繕費-外注費-取替外注費,43", _
"修繕費-外注費-普通外注費,44", "物件費-備消品費-備消品費,50", "物件費-備消品費-建仮振替備消品費,51", _
"物件費-備消品費-少額資産(10万円以上20万円未満),52", "物件費-被服費,54", "物件費-水道光熱費-水道料,55", _
"物件費-水道光熱費-電気料,56", "物件費-水道光熱費-ｶﾞｽ料,57", "その他経費-諸手数料,71", _
"その他経費-委託料-委託料,75", "その他経費-旅費,78", "その他経費-交通費-交通費,79", _
"その他経費-交通費-通勤定期代,80", "その他経費-通信運搬費-通信費,82", "その他経費-通信運搬費-運搬費,83", _
"(不使用)その他経費-通信運搬費-その他,84", "その他経費-清掃料,93", "その他経費-警備料,94", _
"その他経費-雑費-諸費,95", "その他経費-固定資産除却費-撤去費,98", "その他経費-固定資産除却費-除却費,99")
Case 3
d = " "
v = Array("C7 =SUM(C5:C6)", "C10 =SUM(C8:C9)", "C11 =SUM(C7,C10)", "C15 =SUM(C12:C14)", "C23 =SUM(C15:C22)", _
"C24 =SUM(C11,C23)", "D34 =SUM(D31:D33)", "D37 =SUM(D35:D36)", "D38 =SUM(D25:D30,D34,D37)", "D42 =SUM(D40:D41)", _
"D45 =SUM(D43:D44)", "D46 =SUM(D42,D45)", "D53 =SUM(D50:D52)", "D59 =SUM(D55:D58)", "D61 =SUM(D53:D54,D59)", _
"D81 =SUM(D78:D80)", "D85 =SUM(D82:D84)", "D100 =SUM(D98:D99)", _
"D101 =SUM(D69:D71,D75:D77,D81,D85:D86,D90:D97,D100)", "D118 =SUM(D38,D46,D61,D101)")
End Select
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(v)
tmp = Split(v(i), d)
dic(tmp(0)) = tmp(1)
Next
Set SampleDic = dic End Function
少しはコンパクトになりましたか。
連想配列の設定はまだまだ工夫の余地が大きいと思います。
（ふなば） 2023/02/17(金) 12:00:26
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.