Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Microsoft 365)
【困っています】VBA 追加処理の記述を教えてください。
投稿日時: 22/08/25 23:26:11
投稿者: 坊たん

VBA 追加処理の記述を教えてください。
お世話になります。マクロの初心者です、稚拙な部分はご容赦ください。
下記マクロを実行すると、元データが複数のファイルに分割されます。
追加作業としては、@シートの保護
出来上がった全ファイルのシートは1つ(シート名:『Sheet1』のみ)のA列〜H列とJ列は保護され『I列』と『K列』は
保護されない(PWは、【9753】)。かつオートフィルタ設定でオートフィルタの操作は可能。
Aファイルの種類は、CSVでファイルを作成希望。
自動で作成したく(今は手動で毎週100件作成)、ご教示の程お願い致します。
下記に対象リンク先と記述を記します。
リンク先 https://www.helpforest.com/excel/emv_sample/ex100010.htm
-----------------------------------------------------------------------------------
SubSample()
 
DimMacroBAsWorksheet'このブックのシート
DimWb_DataAsWorkbook'1.分割元ブック
DimWb_newAsWorkbook'分割データ保存ブック
DimWsAsString'2.分割元シート名
DimPathAsString'3.分割データ保存先
DimC_GroupAsString'4.グループ対象列
DimGroupNameAsString'グループ名(ブック名)
DimC_CopyAsString'5.コピーデータ右端列
DimYMDAsString'6.保存ブック日付の表示形式
DimPSWAsString'7.読み取りパスワード
DimR_DataAsInteger'データの行番号
DimKoAsInteger'グループの件数
 
SetMacroB=ThisWorkbook.Worksheets(1)'このブックのシート
SetWb_Data=Workbooks(MacroB.Range("C11").Value)'分割元のブック名
Ws=MacroB.Range("C12")
Path=MacroB.Range("C13")&"\"
C_Group=MacroB.Range("C14")
C_Copy=MacroB.Range("C15")
YMD=MacroB.Range("C16")
PSW=MacroB.Range("C17")
 
IfYMD=""Then
YMD=""
Else
YMD=Format(Date,YMD)
EndIf
 
R_Data=2'データの開始行
 
Application.ScreenUpdating=False
Do
Wb_Data.Activate
Worksheets(Ws).Range(Cells(1,1),Cells(1,C_Copy)).Copy'1行目の項目名コピー
Workbooks.Add
ActiveSheet.PasteRange("A1")'新規ブックに貼り付け
SetWb_new=ActiveWorkbook
 
Wb_Data.Activate
GroupName=Cells(R_Data,C_Group)
Ko=WorksheetFunction.CountIf(Columns(C_Group),GroupName)'グループの件数を算出
 
Range(Cells(R_Data,"A"),Cells(R_Data+Ko-1,C_Copy)).Copy'グループ件数分コピー
Wb_new.Activate
ActiveSheet.PasteRange("A2")'新規ブック項目の下に貼り付け
ActiveSheet.Columns.AutoFit
ActiveSheet.UsedRange.Borders.LineStyle=True
Range("D2").Select
ActiveWindow.FreezePanes=True
DimmynameAsString'条件不明
IfActiveSheet.Range("A2")<>""Then
myname=ActiveSheet.Range("A2")
EndIf
 
Wb_new.SaveAsFilename:=Path&GroupName&"注残納期回答依頼リスト"&YMD&".xlsx",_
Password:=PSW'指定したフォルダーに保存
Wb_new.Close
 
R_Data=R_Data+Ko
 
LoopWhileCells(R_Data,C_Group)<>""
 
MsgBox"完了!"
 
Application.ScreenUpdating=True
 
EndSub

回答
投稿日時: 22/08/26 09:52:22
投稿者: simple

こんにちは。

引用:
Aファイルの種類は、CSVでファイルを作成希望。
CSVファイルにはシートの保護といった概念はありません。
そんなことはできませんよ。
CSVファイルとは何かを再度確認してください。
引用:
@シートの保護
出来上がった全ファイルのシートは1つ(シート名:『Sheet1』のみ)のA列〜H列とJ列は保護され『I列』と『K列』は
保護されない(PWは、【9753】)。かつオートフィルタ設定でオートフィルタの操作は可能
まずはその動作をマクロ記録してみて下さい。
参考になるコードが得られるはずです。
I列、J列だけロックをはずして保護します。
 
質問する前にそうしたことを実行していただきたいですね。
そのうえで、ここまではできたがこうした点に詰まっている、解決方法は?
という質問にしてください。
そのほうが、あなたの技術力向上につながると思いますよ。
 
質問の中には、方針すら思いつくのが難しいといったものもあるとは思いますが、
今回の件は、実行内容は明確で、しかも手作業で簡単にできることですから、
マクロ記録の援用で比較的取り組みやすい話じゃないでしょうか。
是非トライしてみて下さい。
(こちらの質問掲示板は作業依頼するところではないので、誤解がないようにしてください。)
 
なお、提示されたコードについては、
DimMacroBAsWorksheet
などと、本来あるべきスペース文字がすべて消えていますよね。
どうやったらこんな質問投稿になるんですか?ちょっと想像できないですが。

回答
投稿日時: 22/08/26 10:47:26
投稿者: WinArrow
投稿者のウェブサイトに移動

>下記マクロを実行すると、元データが複数のファイルに分割されます。
本当ですか?
このコードが動いているとは思えません。
 
この板に掲示したコードは、手入力したのでしょうか?
コードを手入力せずに、コードペインからコピペしてください。

回答
投稿日時: 22/08/26 20:44:16
投稿者: WinArrow
投稿者のウェブサイトに移動

掲示のコードについて
  
他人が作成したコードをそのまま掲示してはいけません。
  
まず、コードの内容を理解してください。
 
その上で、自分のやりたいことと異なる点を見つけて、
そこでわからないことを質問しましょう。
  
とにかく、このままでは、丸投げと同じです。
  
それから、他WEBページへのURLを掲示することは禁止事項です。

投稿日時: 22/08/26 22:19:37
投稿者: 坊たん

皆さん、ありがとうございました。