下面是用于进行预测然后创建 excel 输出的 SAS 代码，一旦输出存储在 excel 文件中，我调用 VBA 宏来为每个 excel 文件和工作簿的每张表生成图表。
在 SAS 宏中，我为我的 excel 文件定义了一个输出路径，我希望在 VBA 宏中使用相同的路径而不使其成为固定值，所以如果我运行这个 sas 代码以在不同的位置获得输出，我的 VBA 会选择从 sas 宏变量开始。
/* SAS Code below */
%macro forcaseting(lib,dsn);
options fmtsearch=(sasuser work);
proc sql noprint;
select distinct name INTO :VAR_NAME SEPARATED BY '|'
from dictionary.columns
where
UPCASE(libname) = "%upcase(&LIB.)"
AND
UPCASE(MEMNAME) = "%upcase(&DSN)"
AND
UPCASE(NAME) NE 'MONTH'
and
upcase(type) = 'NUM'
;
QUIT;
%put &var_name;
PROC DATASETS LIB=WORK NOLIST KILL;RUN;
PROC FORMAT;
PICTURE MNY
LOW - HIGH = '%b-%Y' (DATATYPE=DATE);
RUN;
%PUT &VAR_NAME.;
%let i = 1;
%do %while (%scan(&VAR_NAME.,&i,%str(|)) ne );
%let cur_var = %scan(&VAR_NAME.,&i,%str(|));
%put &cur_var.;
data %sysfunc(compress(A_&cur_var.,,kad));
set &LIB..&DSN.(keep= Month &cur_var.);
retain n 0;
if not missing(&cur_var.) and (&cur_var. gt 0) then n +1;
call symputx ("n",n,'l');
run;
%if %sysevalf(&n.) gt 5 %then %do;
/*Forecasting using HPF*/
proc hpf data=%sysfunc(compress(A_&cur_var.,,kad)) outfor=%sysfunc(compress(A_&cur_var._for,,kad))
outstat=%sysfunc(compress(A_&cur_var._stat,,kad))
lead=4;
id month interval=month;
forecast &cur_var./ model=bestall criterion=mape;
run;
Data _forecast;
length Deal_Name $ 60.;
set %sysfunc(compress(A_&cur_var._for,,kad));
Deal_Name = "&cur_var.";
if ACTUAL not in (0 .) then mape = abs((ACTUAL-PREDICT)/ACTUAL);
else mape=.;
format mape percent8.2;
run;
Data _Final_forecast (drop=_:) ;
length Deal_Name $ 60.;
set
%if %sysfunc(exist(_final_forecast)) %then %do;
_Final_forecast
%end;
/* %sysfunc(compress(A_&cur_var._for,,kad));*/
_forecast
;
run;
options nomprint nomlogic;
;
/*Forecasting using ARIMA*/
PROC ARIMA data=%sysfunc(compress(A_&cur_var.,,kad));
IDENTIFY VAR=&cur_var. ;
ESTIMATE p=1 q=1 ;/*input=per_BL_ACS */;
run;
forecast lead=4 id=month interval=month out=%sysfunc(compress(A_&cur_var._arima,,kad));
run;
quit;
/*Get Observation count of the above dataset */
%let dsid=%sysfunc(open(%sysfunc(compress(A_&cur_var._arima,,kad))));
%let num=%sysfunc(attrn(&dsid.,nlobs));
%let rc=%sysfunc(close(&dsid));
%if %eval(&num.) gt 1 %then %do;
ods tagsets.ExcelXP file="C:\Data\SASOutput\BPO\OUTPUT_PROC_ARIMA\&cur_var..xls" style=Normal
options (
sheet_label=' '
sheet_Name="&cur_var."
suppress_bylines='yes'
autofit_height='Yes'
autofilter='ALL'
frozen_headers='1'
orientation = 'Landscape'
);
data %sysfunc(compress(A_&cur_var._F,,kad));
set %sysfunc(compress(A_&cur_var._arima,,kad));
if &cur_var not in (. 0) then mape = abs((&cur_var-forecast)/&cur_var.);
else mape=.;
format mape percent8.2;
run;
proc print noobs;run;
ods tagsets.ExcelXP close;
;
%end;
%end;
%let i = %eval(&i.+1);
%end;
ods tagsets.ExcelXP file="C:\Data\SASOutput\BPO\OUTPUT_PROC_HPF\HPF.XLS" style=Normal
options (
sheet_interval='bygroup'
sheet_label=' '
suppress_bylines='yes'
autofit_height='Yes'
autofilter='ALL'
frozen_headers='1'
orientation = 'Landscape'
);
proc sort data=_Final_forecast;
by Deal_Name;
run;
proc print data=_Final_forecast noobs ;
by Deal_Name;
run;
ods tagsets.ExcelXP close;
;
/*Create Graph for each of the above file using two VBA CODES */
/*Intiate Excel */
OPTIONS NOXWAIT NOXSYNC;
DATA _NULL_;
RC=SYSTEM('START EXCEL');
RC=SLEEP(5);
RUN;
/*Call VBA macro to create graph for each excel file and for each sheet*/
filename sas2xl dde 'excel|system';
data _null_;
file sas2xl;
put "[open(""C:\VbaTrustedLocation\Arima_template.xlsm"", 0 , true)]";
put "[run(""create_Arima_Chart"")]";
put "[run(""create_Hpf_Chart"")]";
*put '[save.as("C:\Data\SASOutput\BPO\OUTPUT_PROC_ARIMA\acosta1.xls")]';
put '[file.close(false)]';
put '[quit()]';
run;
%mend forcaseting;
/* VB MACRO CODE BELOW */
Sub create_Arima_Chart()
Dim StrFile As String
Dim cell As Range, strTemp As String, c As Variant
Dim sh As Worksheet
Dim i As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
StrFile = Dir("C:\Data\SASOutput\BPO\OUTPUT_PROC_ARIMA\*.xls") ' Looks up each file with CSV extension
Do While Len(StrFile) > 0 ' While the file name is greater then nothing
Workbooks.Open Filename:="C:\Data\SASOutput\BPO\OUTPUT_PROC_ARIMA\" & StrFile ' Open current workbook
For Each sh In ThisWorkbook.Worksheets
For i = 1 To Worksheets.Count
Worksheets(i).Activate
For Each cell In Intersect(Range("A1:H30"), ActiveSheet.UsedRange)
strTemp = cell.Value
For Each c In Array("XZ")
strTemp = strTemp & Range(c & cell.Row).Value
Next c
If Trim(strTemp) = "." Then
cell.ClearContents
End If
Next cell
Columns("A:H").ColumnWidth = 9.57
ActiveSheet.Shapes.AddChart.Select ' Add a chart
ActiveChart.ChartType = xlLine ' Add a chart type
ActiveChart.SetSourceData Source:=Range("$A1:$C1", Range("$A1:$C1").End(xlDown)) ' Set the source range to be the used cells in A:B on the open worksheet
With ActiveChart.Parent
.Height = .Height * 1 'Increase Height by 50%
.Width = .Width * 1.2 'Increase Width by 50%
.Top = 20
.Left = 450
End With
With ActiveChart
.Legend.Select
Selection.Position = xlBottom
.Axes(xlValue).MajorGridlines.Select
Selection.Delete
End With
'Note the setting of the source will only work while there are no skipped blank if you
'have empty rows in the source data please tell me and i can provide you with another
' way to get the information
Next i
Next sh
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Data\SASOutput\BPO\OUTPUT_PROC_ARIMA\output\" & StrFile, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ' Save file as excel xlsx with current files name
ActiveWorkbook.Close ' Close when finished before opening next file this can be removed if you'd like to keep all open for review at the end of loop.
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
StrFile = Dir ' Next File in Dir
Loop
End Sub
Sub create_Hpf_Chart()
Dim StrFile As String
Dim cell As Range, strTemp As String, c As Variant
Dim sh As Worksheet
Dim i As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
StrFile = Dir("C:\Data\SASOutput\BPO\OUTPUT_PROC_HPF\*.xls") ' Looks up each file with CSV extension
Do While Len(StrFile) > 0 ' While the file name is greater then nothing
Workbooks.Open Filename:="C:\Data\SASOutput\BPO\OUTPUT_PROC_HPF\" & StrFile ' Open current workbook
For Each sh In ThisWorkbook.Worksheets
For i = 1 To Worksheets.Count
Worksheets(i).Activate
For Each cell In Intersect(Range("A1:H30"), ActiveSheet.UsedRange)
strTemp = cell.Value
For Each c In Array("XZ")
strTemp = strTemp & Range(c & cell.Row).Value
Next c
If Trim(strTemp) = "." Then
cell.ClearContents
End If
Next cell
Columns("A:H").ColumnWidth = 9.57
ActiveSheet.Shapes.AddChart.Select ' Add a chart
ActiveChart.ChartType = xlLine ' Add a chart type
ActiveChart.SetSourceData Source:=Range("$A1:$C1", Range("$A1:$C1").End(xlDown)) ' Set the source range to be the used cells in A:B on the open worksheet
With ActiveChart.Parent
.Height = .Height * 1 'Increase Height by 50%
.Width = .Width * 1.2 'Increase Width by 50%
.Top = 20
.Left = 450
End With
With ActiveChart
.Legend.Select
Selection.Position = xlBottom
.Axes(xlValue).MajorGridlines.Select
Selection.Delete
End With
'Note the setting of the source will only work while there are no skipped blank if you
'have empty rows in the source data please tell me and i can provide you with another
' way to get the information
Next i
Next sh
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Data\SASOutput\BPO\OUTPUT_PROC_ARIMA\output\" & StrFile, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ' Save file as excel xlsx with current files name
ActiveWorkbook.Close ' Close when finished before opening next file this can be removed if you'd like to keep all open for review at the end of loop.
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
StrFile = Dir ' Next File in Dir
Loop
End Sub
/*%forcaseting(bpo,ATTRITION_MONTHWISE_MAY_FORECAST);*/