在 excel 中调用 TramoSeats 进行季节调整-经管之家官网！

Dim iTask As Long, ret As Long, pHandle As Long Dim fs, fd Dim cell As Range Dim CurrentDrive As String, CurrentPath As String Dim Line As String Dim ss() As String Dim l As Integer, i As Integer Dim rows As Integer, cols As Integer Dim ts_out() As Double Const PathToTramo As String = "c:\tramo" Const PathToOutFile As String = "c:\seats\output\table-s.out" Set fs = CreateObject("Scripting.FileSystemObject") ' Generate the input file Set fd = fs.CreateTextFile(PathToTramo & "\serie", True) l = x.Count fd.writeline ("tmpserie") fd.writeline (l & " " & start_year & " " & start_period & " " & freq) For Each cell In x If IsNumeric(cell) And cell > 0 Then fd.writeline (cell) Else fd.writeline ("-99999") Next cell fd.writeline ("$INPUT RSA=3,LAM=0$") fd.Close Set fd = Nothing CurrentPath = CurDir() CurrentDrive = Left(CurrentPath, 2) ChDrive (Left(PathToTramo, 2)) ChDir (PathToTramo) 'Call ts.exe to do seasonal adjustment iTask = Shell(PathToTramo & "\ts.exe", vbHide) pHandle = OpenProcess(SYNCHRONIZE, False, iTask) ret = WaitForSingleObject(pHandle, INFINITE) ret = CloseHandle(pHandle) ChDrive (CurrentDrive) ChDir (CurrentPath) 'Read the output file Set fd = fs.opentextfile(PathToOutFile, 1) fd.skipline fd.skipline If forecast Then rows = l + 2 * freq Else rows = l If out_serie > 2 Then cols = 2 Else cols = 1 ReDim ts_out(1 To rows, 1 To cols) i = 1 Do While Not fd.atendofstream And i <= rows Line = fd.readline() ss = Split(slim(Line)) Select Case out_serie Case 1 ts_out(i, 1) = ss(3) Case 2 ts_out(i, 1) = ss(4) Case 3 ts_out(i, 1) = ss(3) ts_out(i, 2) = ss(4) Case Else End Select i = i + 1 Loop fd.Close Set fd = Nothing Set fs = Nothing ts = ts_out End Function

Function slim(s As String, Optional d As String = " ") As String 'slip the consecutive delimiter d in string s and trim the left and right delimiters ' 'Copyright June, 2005 by Xia Chun

Dim l As Integer Dim i As Integer

slim = "" l = Len(s) i = 1

'Trim the left delimiters first Do While i <= l And Mid(s, i, 1) = d i = i + 1 Loop

Do While i <= l ' if a delimiter found, skip it until next non-delimiter character, or we simply link the ' character to output and move the pointer next If Mid(s, i, 1) = d Then Do i = i + 1 Loop Until i > l Or Mid(s, i, 1) <> d If i <= l Then slim = slim & d ' if we don't reach the end of string, add a single delimiter to output Else slim = slim & Mid(s, i, 1) i = i + 1 End If Loop

End Function

扫码或添加微信号：坛友素质互助

「经管之家」APP：经管人学习、答疑、交友，就上经管之家！
免流量费下载资料----在经管之家app可以下载论坛上的所有资源，并且不额外收取下载高峰期的论坛币。
涵盖所有经管领域的优秀内容----覆盖经济、管理、金融投资、计量统计、数据分析、国贸、财会等专业的学习宝库，各类资料应有尽有。
来自五湖四海的经管达人----已经有上千万的经管人来到这里，你可以找到任何学科方向、有共同话题的朋友。
经管之家（原人大经济论坛），跨越高校的围墙，带你走进经管知识的新世界。
扫描下方二维码下载并注册APP