不多说了,看程序:
Option Explicit
Type MyType
a1 As Long '日期
a2 As Long '开盘价
a3 As Long '最高价
a4 As Long '最低价
a5 As Long '收盘价
a6 As Long '成交金额
a7 As Long '成交量
a8 As Long '标示码
End Type
Sub add_ri()
Dim File1 As Integer
Dim i As Long
Dim b As MyType
Dim x, y, z, endrow As Integer
Dim a, st, st_for As Integer
Dim sh As Worksheet
Dim str1, str2, str3 As String
Dim str_name As String
Dim code As Integer
Dim maxl As Long
Dim minl As Long
'For a = Worksheets.Count To 1 Step -1
'If sh.Name <> "观察股票" Then
' Exit Sub
'st = Sheet1.Range("b65536").End(xlUp).Row
' For st_for = 2 To st
' Set sh = Sheets.Add
' sh.Name = Sheet1.Range("B" & st_for).Value
' Sheets(sh.Name).Move after:=Sheets(Sheets.Count)
'
For Each sh In Worksheets
If sh.Name <> "观察股票" Then
If Val(sh.Name) >= 600000 Then
str1 = sh.Name
str2 = "sh" & str1 & ".day"
str3 = "G:/new_gxzq/Vipdoc/sh/lday/" & str2
Worksheets(str1).Activate
Else
str1 = sh.Name
str2 = "sz" & str1 & ".day"
str3 = "G:/new_gxzq/Vipdoc/sz/lday/" & str2
Worksheets(str1).Activate
End If
'Next st_for
'Sheet1.Select
'Else
' MsgBox "添加工作表"
'End If
'Next
'
'
'
'
File1 = FreeFile
Open str3 For Binary Access Read As #File1
i = 1
Do While Not EOF(File1)
Get #File1, , b
Cells(i, 1) = b.a1
Cells(i, 2) = b.a2 / 100
Cells(i, 3) = b.a3 / 100
Cells(i, 4) = b.a4 / 100
Cells(i, 5) = b.a5 / 100
Cells(i, 6) = b.a6 / 10000
Cells(i, 7) = b.a7 / 100
Cells(i, 8) = b.a8
i = i + 1
Loop
Close #File1
endrow = Range("a65536").End(xlUp).Row
If endrow >= 180 Then
z = endrow - 180
Else
z = 2
End If
maxl = Application.WorksheetFunction.Max(Range("G:G"))
minl = Application.WorksheetFunction.Min(Range("G:G"))
For y = z To endrow
If Range("G" & (y - 1)).Value = 0 Then
Range("I" & (y - 1)) = "-停牌-"
ElseIf Range("G" & y).Value = 0 Then
Range("I" & y) = "-停牌-"
Else
Range("I" & y) = "=G" & y & "/G" & y - 1
End If
For x = 1 To 9
If Range("I" & y).Value >= 2 * 0.964 And (Range("E" & y).Value - Range("B" & y).Value) > 0 And Range("I" & y).Value < maxl * 0.382 Then
Cells(y, x).Interior.ColorIndex = 3
ElseIf Range("I" & y).Value >= 1.036 And Range("I" & y).Value < 2 * 0.964 And Range("I" & y).Value < maxl * 0.382 Then
Cells(y, x).Interior.ColorIndex = 0
ElseIf Range("I" & y).Value >= 0.964 And Range("I" & y).Value < 1.036 Then
Cells(y, x).Interior.ColorIndex = 4
ElseIf Range("I" & y).Value >= 0.618 And Range("I" & y).Value < 0.964 And Range("I" & y).Value < maxl * 0.382 Then
Cells(y, x).Interior.ColorIndex = 0
ElseIf Range("I" & y).Value >= 0.382 And Range("I" & y).Value < 0.618 And Range("I" & y).Value < maxl * 0.382 Then
Cells(y, x).Interior.ColorIndex = 4
ElseIf Range("I" & y).Value >= 0.008 And Range("I" & y).Value < 0.382 Then
Cells(y, x).Interior.ColorIndex = 3
Else
Cells(y, x).Interior.ColorIndex = 6
End If
Next x
Next y
str_name = sh.Name
Range("J" & (endrow)) = "'" & str_name
Range("J" & (endrow)).Offset(0, 1) = Range("K1").Text
'For code = 2 To endrow2
'If Sheet1.Range("" & code) = str_name Then
'Range("h" & (endrow + 2)).Offset(0, 1) = Sheet1.Range("" & code).Offset(0, 1)
'Else
'End If
'Next code
Range("a65536").End(xlUp).EntireRow.Select
'End If
'Next a
Else '工作表名称为“观察股”
End If
Next sh
End Sub