填充原始图形中的特定区域

Question

嗨 我有一个从外汇网站下载的基于 Excel 的图表文件。 我将在下面给出下载链接。 我想要的是将填充应用于整个图形的某些区域，正如我在图像中所解释的那样。

示例

链接：forexpnf 网站

我想通过chartcol和chartcol定义将其定义为+和-，但没有成功。 我没有足够的编码知识来做到这一点。

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 = up 0 = down
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")
   'Clear any previous chart
   Range("E4:IV2114").Select
   Selection.ClearContents
   
   BlockSize = ChartP.Cells(2, 5)
   Reversal = ChartP.Cells(3, 5)
   CurrentTrend = 1
   
   ' work out axis and labels
   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  ' row where chart starts
   ChartRow = ChartAxis
   ChartCol = 6
   'Label the chart axis's
   '30 points + and - the first number
   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   ' CurrentTrend = UP
         NewPrice = Data.Cells(x, 3)  ' days high
         If NewPrice >= CurrentPrice + BlockSize Then ' mark up
            Do While NewPrice >= CurrentPrice + BlockSize
               ChartRow = ChartRow - 1
               ChartP.Cells(ChartRow, ChartCol) = "X"
               CurrentPrice = CurrentPrice + BlockSize
            Loop
         Else ' look for a reversal
             NewPrice = Data.Cells(x, 4)  ' days low
             If NewPrice <= CurrentPrice - (BlockSize * Reversal) Then
               CurrentTrend = 0
               ChartCol = ChartCol + 1
               Do While NewPrice <= CurrentPrice - BlockSize
                  ChartRow = ChartRow + 1
                  ChartP.Cells(ChartRow, ChartCol) = "0"
                  CurrentPrice = CurrentPrice - BlockSize
               Loop
            End If
         End If
      
      Else   ' Current Trend = down
         NewPrice = Data.Cells(x, 4)  ' days low
         If NewPrice <= CurrentPrice - BlockSize Then
            Do While NewPrice <= CurrentPrice - BlockSize
               ChartRow = ChartRow + 1
               ChartP.Cells(ChartRow, ChartCol) = "0"
               CurrentPrice = CurrentPrice - BlockSize
            Loop
         Else   ' look for a reversal
            NewPrice = Data.Cells(x, 3)  ' days high
            If NewPrice >= CurrentPrice + (BlockSize * Reversal) Then
               CurrentTrend = 1
               ChartCol = ChartCol + 1
               Do While NewPrice >= CurrentPrice + BlockSize
                  ChartRow = ChartRow - 1
                  ChartP.Cells(ChartRow, ChartCol) = "X"
                  CurrentPrice = CurrentPrice + BlockSize
               Loop
            End If
          End If
       End If
      
      x = x + 1
   Loop
   
End Sub

Sub ClearData()
    Range("A1:B3000").Select
    Selection.ClearContents
End Sub

Answer 1

此代码在工作表上产生以下结果

Sub plus_minus_color()
Set rang = Range("B4:O25") 'the range to check
'first or the last row of the sheet must not contains any data.
defcolor = rgbLightGreen ' the backcolor of the cell
firstcol = rang.Columns(1).Column
lastcol = rang.Columns(rang.Columns.Count).Column

If Cells(1, firstcol).End(xlDown) = "o" Then

For i = firstcol To lastcol - 2 Step 2
  If Not IsEmpty(Cells(Rows.Count, i).End(xlUp).Offset(1, 2)) Then
    Cells(Rows.Count, i).End(xlUp).Offset(1, 2).Interior.Color = defcolor
  End If
  If Not IsEmpty(Cells(1, i + 1).End(xlDown).Offset(-1, 2)) Then
    Cells(1, i + 1).End(xlDown).Offset(-1, 2).Interior.Color = defcolor
  End If
Next i

Else

For i = firstcol To lastcol - 2 Step 2
  If Not IsEmpty(Cells(Rows.Count, i + 1).End(xlUp).Offset(1, 2)) Then
    Cells(Rows.Count, i + 1).End(xlUp).Offset(1, 2).Interior.Color = defcolor
  End If
  If Not IsEmpty(Cells(1, i).End(xlDown).Offset(-1, 2)) Then
    Cells(1, i).End(xlDown).Offset(-1, 2).Interior.Color = defcolor
  End If
Next i

End If

End Sub