selectstock.bas

股票分析

              AllStock(i).Vol = SHDP.Vol
              i = i + 1
          Wend
     Close #1
     txt = Dir(DayDir)
     GoalTxt = ""
     While txt <> ""
       If Mid(txt, 1, 5) = "SH600" Or Mid(txt, 1, 5) = "SZ000" Then

         myFileName = DayDir + txt
         StartPrice = 0
         EndPrice = 0
         i = 1: Erase OneStock
         Open myFileName For Binary As #1 Len = Len(DFS)
         While Not EOF(1)
              Get #1, , DFS
              OneStock(i).ClosePrice = DFS.ClosePrice
              OneStock(i).LowPrice = DFS.LowPrice
              OneStock(i).myDate = DFS.myDate
              OneStock(i).OpenPrice = DFS.OpenPrice
              OneStock(i).TopPrice = DFS.TopPrice
              OneStock(i).TotalChange = DFS.TotalChange
              OneStock(i).Vol = DFS.Vol
              OneStock(i).YestodayColsePrice = DFS.YestodayColsePrice
              i = i + 1
         Wend
         Close #1
         DateCount = 0
         DateComp = 0
         For i = 1 To 6000
             If OneStock(i).ClosePrice = 0 Then pflg = i - 1: Exit For
             flg = 0
             If StartDate <> 0 And EndDate <> 0 Then
                If OneStock(i).myDate >= StartDate And OneStock(i).myDate <= EndDate Then
                   For j = 1 To 6000
                       If AllStock(j).myDate = 0 Then Exit For
                       If AllStock(j).myDate = OneStock(i).myDate Then
                          For k = j To 6000
                              If AllStock(k).myDate = 0 Then Exit For
                              If AllStock(k).myDate = OneStock(i + 1).myDate Then Exit For
                          Next k
                          Exit For
                       End If
                   Next j
                   If AllStock(j).myDate <> 0 And AllStock(k).myDate <> 0 Then flg = 1
                End If
             Else
                   For j = 1 To 6000
                       If AllStock(j).myDate = 0 Then Exit For
                       If AllStock(j).myDate = OneStock(i).myDate Then
                          For k = j + 1 To 6000
                              If AllStock(k).myDate = 0 Then Exit For
                              If AllStock(k).myDate = OneStock(i + 1).myDate Then Exit For
                          Next k
                          Exit For
                       End If
                   Next j
                   If AllStock(j).myDate <> 0 And AllStock(k).myDate <> 0 Then flg = 1
             End If
             If flg = 1 Then
                If (AllStock(j).ClosePoint > AllStock(k).ClosePoint And _
                   OneStock(i).ClosePrice < OneStock(i + 1).ClosePrice) Or _
                   (AllStock(j).ClosePoint < AllStock(k).ClosePoint And _
                   OneStock(i).ClosePrice > OneStock(i + 1).ClosePrice) _
                   Then
                   DateComp = DateComp + 1
                End If
             End If
         
         Next
         DateCount = i - 1
         If TopPrice <> 0 Then
            If OneStock(pflg).ClosePrice >= LowPrice * 100 And OneStock(pflg).ClosePrice <= TopPrice * 100 Then
               y = y + 1
               myWork.Cells(y, 1) = txt
               myWork.Cells(y, 2) = DateCount
               myWork.Cells(y, 3) = DateComp

            End If
         Else
            y = y + 1
            myWork.Cells(y, 1) = txt
            myWork.Cells(y, 2) = DateCount
            myWork.Cells(y, 3) = DateComp
         End If
       End If

         
         
         'GoTo myOut
        txt = Dir()
        
     Wend
myOut:

    
 
 
    myWork.SaveAs myExcelFileName
    myExcel.Close
    
    Set myWork = Nothing
    Set myExcel = Nothing

    getCompOneStockAndAllStock = 1
    Exit Function

myEnd:
    myExcel.Close
    
    Set myWork = Nothing
    Set myExcel = Nothing


    getCompOneStockAndAllStock = 0






End Function

Public Function getLongFor100() As Integer
    Dim myExcel As Excel.Workbook
    Dim myWork As Excel.Worksheet
    Dim myExcel2 As Excel.Workbook
    Dim myWork2 As Excel.Worksheet

    Dim myExcelFileName, myExcelFileName2, myFileName, myTxt As String
    Dim i, y, flg As Integer
    Dim OneLTG(2000, 2), LTG As Double
    Dim OneStock(6000) As SCStockDayStruct
On Error GoTo myEnd
    myExcelFileName = MainDir + "ssgoal.xls"
    myExcelFileName2 = DayDir + "base.xls"
    Set myExcel = Workbooks.Open(myExcelFileName)            'Open("m:\Stock Operation System\sn_600899\Stock Data In Long.xls")
    Set myWork = myExcel.Worksheets.Add    '.Worksheets(5)
    Set myExcel2 = Workbooks.Open(myExcelFileName2)            'Open("m:\Stock Operation System\sn_600899\Stock Data In Long.xls")
    Set myWork2 = myExcel2.Worksheets(1)    '.Worksheets(5)
    For i = 3 To 2000
        If myWork2.Cells(i, 2) = "" Then Exit For
        OneLTG(i - 2, 1) = myWork2.Cells(i, 2)
        OneLTG(i - 2, 2) = myWork2.Cells(i, 10)
    Next
    
    
    myExcel2.Close
    
    Set myWork2 = Nothing
    Set myExcel2 = Nothing

    y = 1
    myWork.Cells(y, 1) = "股票至今日又100%换手，它的开始日期："
    
    y = y + 1
    myWork.Cells(y, 1) = "代码："
    myWork.Cells(y, 2) = "开始日期 ："

     myTxt = Dir(DayDir)
     While myTxt <> ""
       If Left(myTxt, 5) = "SH600" Or Left(myTxt, 5) = "SZ000" Then

         myFileName = DayDir + myTxt
         i = 1: Erase OneStock
         Open myFileName For Binary As #1 Len = Len(DFS)
         While Not EOF(1)
              Get #1, , DFS
              OneStock(i).ClosePrice = DFS.ClosePrice
              OneStock(i).LowPrice = DFS.LowPrice
              OneStock(i).myDate = DFS.myDate
              OneStock(i).OpenPrice = DFS.OpenPrice
              OneStock(i).TopPrice = DFS.TopPrice
              OneStock(i).TotalChange = DFS.TotalChange
              OneStock(i).Vol = DFS.Vol
              OneStock(i).YestodayColsePrice = DFS.YestodayColsePrice
              i = i + 1
         Wend
         Close #1
         LTG = 0
        ' MsgBox myTxt
         For i = 1 To 2000
               If OneLTG(i, 1) = Mid(myTxt, 3, 6) Then LTG = OneLTG(i, 2) * 10000: Exit For
         Next
         If i >= 2000 Then GoTo aaa
         flg = 5999
         If OneLTG(i, 1) = Mid(myTxt, 3, 6) Then
             For i = 5999 To 1 Step -1
                 If OneStock(i).ClosePrice <> 0 And OneStock(i + 1).ClosePrice = 0 Then flg = i
                 LTG = LTG - OneStock(i).Vol
                 If LTG < 0 Then Exit For
             
             Next
         End If
         If TopPrice <> 0 And flg <> 5999 Then
            If OneStock(flg).ClosePrice >= LowPrice * 100 And OneStock(flg).ClosePrice <= TopPrice * 100 Then
               y = y + 1
               myWork.Cells(y, 1) = myTxt
               myWork.Cells(y, 2) = OneStock(i).myDate
            End If
        Else
            y = y + 1
            myWork.Cells(y, 1) = myTxt
            myWork.Cells(y, 2) = OneStock(i).myDate

        End If
      End If
aaa:
         
        myTxt = Dir()
        
     Wend
myOut:

    
 
 
    myWork.SaveAs myExcelFileName
    myExcel.Close
    
    Set myWork = Nothing
    Set myExcel = Nothing

    getLongFor100 = 1
    Exit Function

myEnd:
'    myExcel.Close
    
    Set myWork = Nothing
    Set myExcel = Nothing




    getLongFor100 = 0





End Function