0
下面是SAS代码，用于做预测，然后创建一个excel输出，一旦输出存储在excel文件中，我调用一个VBA宏为每个excel生成一个图文件和工作簿的每个工作表。将sas宏变量传递给VB脚本作为参数
在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);*/
通过位置作为参数 – 2013-05-15 11:38:48
你已经有太多的代码。我强烈建议发布一个简短的，自包含的示例，以显示您感兴趣的内容，而无需任何其他详细信息，因此我们不必花时间浏览代码。 – Joe