跨列进行计算,然后是多个工作表

时间:2018-01-27 08:10:27

标签: vba excel-vba excel

我试图计算70K行数据的股票价格之间的差异,插入新列,然后在工作簿中的多个工作表中执行相同操作。我已经获得了插入列的代码,添加了Distinct Ticker和Tot。每个不同股票的交易量 - 但我仍然坚持要减去两个数字并插入第三列...这是我的代码到目前为止(道歉如果发布不好 - 我' m一切都是新的!):

Sub StockData()

For Each ws In Worksheets

    'variables
    Dim WorksheetName As String
    WorksheetName = ws.Name
    Dim StockVolume As Double
    Dim Ticker As String
    Dim YearlyChange As Double
    Dim PercentChange As Double
    Dim Summary_Table_Row As Double
    Dim yearly_open As Double
    Dim yearly_close As Double
    Summary_Table_Row = 2
    Dim color_options(1) As Integer
    color_options(0) = 10
    color_options(1) = 3
    '-------------------------

    lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row

    'set new table headings
    ws.Cells(1, 9).Value = "Ticker"
    ws.Cells(1, 10).Value = "Total Stock Volume"
    '------------------------

    For i = 2 To lastrow
        If ws.Cells(i + 1, 1).Value <> ws.Cells(i, 1).Value Then
            Ticker = ws.Cells(i, 1).Value
            StockVolume = StockVolume + ws.Cells(i, 7)
            ws.Range("I" & Summary_Table_Row).Value = Ticker
            ws.Range("J" & Summary_Table_Row).Value = StockVolume
            Summary_Table_Row = Summary_Table_Row + 1
            StockVolume = 0

            Else
                StockVolume = StockVolume + ws.Cells(i, 7)
        End If
    Next i

    'set new table headings
    ws.Range("j1").EntireColumn.Insert
    ws.Cells(1, 10).Value = "Yearly Change"
    ws.Range("k1").EntireColumn.Insert
    ws.Cells(1, 11).Value = "Percent Change"
    '------------------------

    For i = 2 To lastrow
        ws.Cells(i, 3).Value = yearly_open
        ws.Cells(i, 6).Value = yearly_close
        YearlyChange = (yearly_open - yearly_close)
        PercentChange = (YearlyChange / yearly_open)
        ws.Range("j1" & Summary_Table_Row).Value = YearlyChange
        ws.Range("k1" & Summary_Table_Row).Value = PercentChange
        Cells(i, 11).NumberFormat = "0.00%"
    Next i

    If (ws.Cells(i, 10).Value > 0) Then
        ws.Cells(i, 10).Interior.ColorIndex = color_options(0)
    ElseIf (ws.Cells(i, 10).Value <= 0) Then
        ws.Cells(i, 10).Interior.ColorIndex = color_options(1)
    End If
Next ws

End Sub

这是数据的错误复制/粘贴...

<ticker>    <date>  <open>  <high>  <low>   <close> <vol>
A   20160101    41.81   -42.36365509    41.81   41.81   0
A   20160104    41.06   -1.305047274    40.34   40.69   3287300
A   20160105    40.73   0.902213812 40.34   40.55   2587200
A   20160106    40.24   0.71801573  40.05   40.73   2103600
A   20160107    40.14   3.227402925 38.81   39  3504300
A   20160108    39.22   0.716412187 38.47   38.59   3736700
A   20160111    38.71   0.206870243 37.41   37.94   2818600
A   20160112    38.43   0.581144869 37.65   38.19   1989300
A   20160113    38.35   0.212442726 36.72   36.86   4206600

0 个答案:

没有答案