You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

为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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.06.17 07:20:56