为Excel点数图特定区域添加填充效果的VBA技术需求
为外汇点数图添加填充效果的VBA解决方案
我从外汇网站下载了一份基于Excel的点数图文件,希望为图表的特定区域添加填充效果(参考示例图样式)。尝试通过ChartCol定义正负区域实现,但未成功,自身编码能力不足。以下是修改后的VBA代码,可实现对应区域的填充效果:
Dim Data As Worksheet Dim ChartP As Worksheet Dim RowNo As Integer Dim ChartRow As Integer Dim ChartCol As Integer Dim ChartAxis As Integer Dim ChartStart As Double Dim Label As Double Dim x As Integer Dim BlockSize As Double Dim Reversal As Double Dim CurrentPrice As Double Dim CurrentTrend As Integer ' 1 = 上涨 0 = 下跌 Dim NewPrice As Double Dim high As Double Dim low As Double Dim upcount As Double Dim downcount As Double Public Sub Calculate() Set Data = Worksheets("OHLCV") Set ChartP = Worksheets("Chart") ' 清除之前的图表内容和格式 Range("E4:IV2114").ClearContents Range("E4:IV2114").ClearFormats BlockSize = ChartP.Cells(2, 5) Reversal = ChartP.Cells(3, 5) CurrentTrend = 1 ' 计算坐标轴范围和标签 x = 1 high = 0 low = 10000000 Do While Data.Cells(x, 5) <> "" If Data.Cells(x, 3) > high Then high = Data.Cells(x, 3) If Data.Cells(x, 4) < low Then low = Data.Cells(x, 4) x = x + 1 Loop upcount = ((high - Data.Cells(1, 3)) / BlockSize) downcount = ((Data.Cells(1, 3) - low) / BlockSize) ChartAxis = upcount + 8 ' 图表起始行 ChartRow = ChartAxis ChartCol = 6 ' 设置坐标轴标签 ChartStart = Data.Cells(1, 3) Data.Cells(ChartAxis, 5) = ChartStart For x = 1 To upcount + 1 Label = ChartStart + (x * BlockSize) ChartP.Cells(ChartAxis - x, 5) = Label Next x For x = 1 To downcount + 1 Label = ChartStart - (x * BlockSize) ChartP.Cells(ChartAxis + x, 5) = Label Next x x = 1 CurrentPrice = ChartStart Do While Data.Cells(x, 5) <> "" If CurrentTrend = 1 Then ' 当前趋势为上涨 NewPrice = Data.Cells(x, 3) ' 当日最高价 If NewPrice >= CurrentPrice + BlockSize Then ' 标记上涨柱 Do While NewPrice >= CurrentPrice + BlockSize ChartRow = ChartRow - 1 With ChartP.Cells(ChartRow, ChartCol) .Value = "X" .Interior.Color = RGB(0, 176, 80) ' 绿色填充上涨区域 End With CurrentPrice = CurrentPrice + BlockSize Loop Else ' 检查反转信号 NewPrice = Data.Cells(x, 4) ' 当日最低价 If NewPrice <= CurrentPrice - (BlockSize * Reversal) Then CurrentTrend = 0 ChartCol = ChartCol + 1 Do While NewPrice <= CurrentPrice - BlockSize ChartRow = ChartRow + 1 With ChartP.Cells(ChartRow, ChartCol) .Value = "0" .Interior.Color = RGB(255, 0, 0) ' 红色填充下跌区域 End With CurrentPrice = CurrentPrice - BlockSize Loop End If End If Else ' 当前趋势为下跌 NewPrice = Data.Cells(x, 4) ' 当日最低价 If NewPrice <= CurrentPrice - BlockSize Then Do While NewPrice <= CurrentPrice - BlockSize ChartRow = ChartRow + 1 With ChartP.Cells(ChartRow, ChartCol) .Value = "0" .Interior.Color = RGB(255, 0, 0) ' 红色填充下跌区域 End With CurrentPrice = CurrentPrice - BlockSize Loop Else ' 检查反转信号 NewPrice = Data.Cells(x, 3) ' 当日最高价 If NewPrice >= CurrentPrice + (BlockSize * Reversal) Then CurrentTrend = 1 ChartCol = ChartCol + 1 Do While NewPrice >= CurrentPrice + BlockSize ChartRow = ChartRow - 1 With ChartP.Cells(ChartRow, ChartCol) .Value = "X" .Interior.Color = RGB(0, 176, 80) ' 绿色填充上涨区域 End With CurrentPrice = CurrentPrice + BlockSize Loop End If End If End If x = x + 1 Loop End Sub Sub ClearData() Range("A1:B3000").ClearContents Range("A1:B3000").ClearFormats End Sub
修改说明:
- 在绘制"X"(上涨)和"0"(下跌)单元格时,新增
Interior.Color属性设置对应填充色,可根据需求调整RGB值 - 补充清除格式的代码,避免旧格式残留
- 注释改为中文,便于理解
内容的提问来源于stack exchange,提问作者ozgn
相关产品推荐
相关产品推荐

