【困っています】VBA 追加処理の記述を教えてください。
未読分：1件
昨日以降(0) ２日前以降(0) ３日前以降(0) ４日前以降(0) ５日前以降(0)
Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応
近田 伸矢, 植木 悠二, 上田 寛
IEのデータ収集＆自動操作のプログラミング本はこの1冊だけ！IEの起動やポップアップウィンドウ、表示を制御する基本的なコードはもちろん、テキストボックスやラジオボタン、表、ハイパーリンクなどのHTML部品を制御する方法など、自動操作に欠かせないノウハウを丁寧に解説。
| Message#1 2022年8月25日(木)23時39分 From: 鈴木太郎 | 返事 削除 変更 |
| VBA 追加処理の記述を教えてください。 お世話になります。マクロの初心者です、稚拙な部分はご容赦ください。 下記マクロを実行すると、元データが複数のファイルに分割されます。 追加作業としては、@シートの保護 出来上がった全ファイルのシートは１つ(シート名：『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 |
昨日以降 ２日前以降 ３日前以降 ４日前以降 ５日前以降
