时间序列数据，怎么用vba写一个排序的命令

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

跪求大神们帮忙，非常非常感谢！

先贴一个我自己写的函数的公式
=IF(ISBLANK(return!B2),"",IF(RANK(return!B2,return!$B2:$IPS2)<=80,1,IF(RANK(return!B2,return!$B2:$IPS2,1)<=80,-1,0)))

样本是6519*9653的，也就是从A1到IPS9653。A列是日期，第一行是变量名称，数据是从B2到IPS9653。
运算逻辑是，首先排除空单元格，每一行找出排序前80的标记为1，排序末80的标记为-1，其他标记为0。

可能是我电脑问题，用函数公式计算量太大，程序不断停止运行，非常痛苦，但我自己又不会vba，又来不及学，所以来找大家帮忙，真的非常感谢！

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏0 回帖

关键词：时间序列数据 序列数据 时间序列 VBA RETURN

如果方便，上传数据。函数运算量大，不过可以先手动更新计算写公式。

車樹森 发表于 2018-3-20 08:14
如果方便，上传数据。函数运算量大，不过可以先手动更新计算写公式。

谢谢回复，我自己学习了一下，写了一个比较蠢的vba，也算运行成功了，但是耗时非常久。
贴一下我的代码，有可以改进的地方希望能指出，谢谢啦~

Sub ReturnRank()

Dim a, b, i, j

For i = 2 To 9654
  For j = 2 To 6519
  
    If IsEmpty(Worksheets("return").Cells(i, j).Value) Then
         Worksheets("rank").Cells(i, j).Value = ""
    Else
         Worksheets("return").Activate
         a = Application.WorksheetFunction.rank(Cells(i, j), Range(Cells(i, 2), Cells(i, 6519)), 0)
         b = Application.WorksheetFunction.rank(Cells(i, j), Range(Cells(i, 2), Cells(i, 6519)), 1)
         

         If a <= 80 Then
            Worksheets("rank").Cells(i, j).Value = 1
         ElseIf b <= 80 Then
            Worksheets("rank").Cells(i, j).Value = -1
         Else
            Worksheets("rank").Cells(i, j).Value = 0
            
         End If
    End If
   
  Next j

Next i

End Sub

解决问题就好啊

如果要运行速度提升要用数组运算替换掉单元格运算
出结果后再复制到单元格上

如果要运行速度提升要用数组运算替换掉单元格运算
出结果后再复制到单元格上

lansnode 发表于 2018-3-22 14:07
如果要运行速度提升要用数组运算替换掉单元格运算
出结果后再复制到单元格上

我查了数组运算的原理，大概明白了思路，不过一时想不到我的问题能把哪个部分作为数组，能稍微帮我看一下吗？下面是新的代码，虽然能够解决问题，但是做完整个计算要几十个小时，还是觉得必须优化。

Sub dummyvariables()

Dim i, j, n, a, b, c

  For j = 2 To 6519  '列数
  
    For n = 2 To 446  'dummy variable的行
        
          a = 0  'rank单元格1的个数，前80
          b = 0  'rank单元格-1的个数，末80
          c = 0  'rank单元格0的个数，中间
         
      For i = (n - 2) * 20 + 2 To (n - 1) * 23 'rank的行
  
        
        If Not IsEmpty(Worksheets("rank").Cells(i, j).Value) And Month(Worksheets("rank").Cells(i, 1)) = Month(Worksheets("winners").Cells(n, 1)) And Year(Worksheets("rank").Cells(i, 1)) = Year(Worksheets("winners").Cells(n, 1)) Then
           '先判断rank的单元格不为空，然后判断rank单元格的年月和winners相同
          If Worksheets("rank").Cells(i, j).Value = 1 Then
            a = a + 1
          ElseIf Worksheets("rank").Cells(i, j).Value = -1 Then
            b = b + 1
          ElseIf Worksheets("rank").Cells(i, j).Value = 0 Then
            c = c + 1
          End If
        End If
      Next i
        
            If a > 0 And b = 0 Then
            Worksheets("winners").Cells(n, j).Value = 1
            Worksheets("losers").Cells(n, j).Value = 0
            Worksheets("both").Cells(n, j).Value = 0
            Worksheets("never").Cells(n, j).Value = 0
            ElseIf a = 0 And b > 0 Then
            Worksheets("losers").Cells(n, j).Value = 1
            Worksheets("winners").Cells(n, j).Value = 0
            Worksheets("both").Cells(n, j).Value = 0
            Worksheets("never").Cells(n, j).Value = 0
            ElseIf a > 0 And b > 0 Then
            Worksheets("both").Cells(n, j).Value = 1
            Worksheets("winners").Cells(n, j).Value = 0
            Worksheets("losers").Cells(n, j).Value = 0
            Worksheets("never").Cells(n, j).Value = 0
            ElseIf a = 0 And b = 0 And c > 0 Then
            Worksheets("never").Cells(n, j).Value = 1
            Worksheets("winners").Cells(n, j).Value = 0
            Worksheets("losers").Cells(n, j).Value = 0
            Worksheets("both").Cells(n, j).Value = 0
            End If
    Next n
            
  Next j
            
            
End Sub