列の追加と削除マクロ
csvを取り込んで、列の追加と削除をしたいですが、
エラーになってしまい、マクロがうまく動きません。
■マクロでやりたいこと
・M、O、P列を削除する
・AO、AQ列の間に列を挿入
列名を「企画ID（廃止）」とする
■エラー内容
実行時エラー 「オーバーフローしました」というエラーがでる
下記がvb構文になります。
どなたかご回答お願いします。
===========================================================================================================================
'
' CSVファイルの読込を行う
'
'===========================================================================================================================
Function ReadCSV(filename As String) As Boolean
Dim hanbaiwaku_wb As Workbook
Dim hanbaiwaku_ws As Worksheet
Dim wbk As Workbook
Dim fname As String
Dim endrow As Long
Dim openflg As Boolean
Dim i As Integer
'画面の更新などを行なわない様にする
SetScreenState (False)
'処理中メッセージを表示する
UserForm1.Show vbModeless
UserForm1.Repaint
'選択されたkowaku.csvファイルを開く
Set hanbaiwaku_wb = Workbooks.Open(filename, ReadOnly:=True)
Set hanbaiwaku_ws = hanbaiwaku_wb.Sheets(1)
'最終行を取得する
endrow = CLng(hanbaiwaku_ws.Range("A1").End(xlDown).Row)
'2行目から最終行までループ(1行目は見出しの為、飛ばす)
For i = 2 To endrow
hanbaiwaku_ws.Range("A" & i).Value = SubstitutionStatus(kowaku_ws.Range("A" & i).Value)
Next
'処理中メッセージを削除する
Unload UserForm1
'ファイル検索用のファイル名を設定する
fname = ThisWorkbook.Path & "\変換済み_" & hanbaiwaku_wb.Name
'ファイルが開かれている場合、上書きが出来ない為、ブックが開かれているか調べる
For Each wbk In Workbooks
'同一名称のブックがある場合、処理を抜ける
If wbk.Name = Dir(fname) Then
Exit For
End If
Next
'ブックが取得されなかった場合
If wbk Is Nothing Then
'変換後の内容を別名で保存する
hanbaiwaku_wb.SaveAs filename:=fname
openflg = True
'ブックの取得が行われていた場合
Else
'ブックの名称とファイル検索用のファイル名を比較し、
'同一であった場合、ファイルが開かれていると判定し、メッセージを表示する。
If wbk.Name = Dir(fname) Then
MsgBox (Dir(fname) & "が開かれている為、保存する事が出来ません。ブックを閉じてください。")
openflg = False
'ブックの名称が比較用文字列と異なる場合
Else
'変換後の内容を別名で保存する
hanbaiwaku_wb.SaveAs filename:="変換済み_" & hanbaiwaku_wb.Name
openflg = True
End If
End If
'kowaku.csvを閉じる
hanbaiwaku_wb.Close
'解放処理
Set hanbaiwaku_wb = Nothing
Set hanbaiwaku_ws = Nothing
'画面の更新などを行う様にする
SetScreenState (True)
'処理結果を返す
ReadCSV = openflg
End Function
'===========================================================================================================================
'
' 不要な列の削除を行う
' 13.15.16列の削除を行う
'
'===========================================================================================================================
Function SubstitutionStatus(txt As String)
Sub prcDeleteRows()
'列を削除します
Columns("13:13,15:16").Delete Shift:=xlToLeft
'列を追加します
Sub 列追加()
'
' 列追加 Macro'
Columns("AP:AP").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AP1").Select
ActiveCell.FormulaR1C1 = "企画ID（廃止）"
ActiveCell.Characters(1, 2).PhoneticCharacters = "キカク"
ActiveCell.Characters(6, 2).PhoneticCharacters = "ハイシ"
Range("AP2").Select
End Function
End If
'結果を返す
SubstitutionStatus = txt
End Sub
![その他([技術者向] コンピューター) イメージ](https://gazo.okwave.jp/okwave/spn/images/related_qa/c205_2_thumbnail_img_sm.png)
お礼
みてみます。 nicotinismさまでもわからないことがあるのですね。 ご回答ありがとうございました。