%急*小女求助*一段宏,,,,(方漠大哥,那样改也不对) ， ,

ppsnow

下面的程序目的:使得如图说示的图表根据值的大小相应的改变颜色，

这是一段宏的程序，指定在右面那个图的下拉框上，

具体是在report-by-dept 的右面那个图，　当选择EDM， 再选择2006-10月到 2006-11月时，图标的颜色不对了，有时候都是一红一绿， 有时候都是红色， 很是奇怪，， 按例应该都是绿色的，应为都小于90%，但多试几次有时候又会对，,,,到底错在什么地方呢?? 是不是把这段宏指定在UPDATE这个按钮上呢，不过，我试过似乎不可以，

请大虾诊断，，，，，


Sub Chartcolor1()

' if the cell value<90%  green
' if the cell value 90%~105%  yellow
' if the cell value  >105% red

Dim ICol, JCol As Integer
  Dim myRange, CRange As Range


  Set myRange = ActiveSheet.Range("A21:BC21")
  ICol = Application.WorksheetFunction.Match(Range("N26"), myRange)
  JCol = Application.WorksheetFunction.Match(Range("26"), myRange)
   

Set CRange = Range(ActiveSheet.Cells(22, ICol), ActiveSheet.Cells(22, JCol))
i = 1
ActiveSheet.ChartObjects(2).Activate
    With ActiveChart.SeriesCollection(1)
        For Each CEL In CRange 'Range("b22:bc22")
            Select Case CEL.Value
                Case Is < 0.9
                    .Points(i).Interior.ColorIndex = 4   

              Case 0.9 To 1.05
                    .Points(i).Interior.ColorIndex = 27
                Case Is > 1.05
                   .Points(i).Interior.ColorIndex = 3
            End Select
            i = i + 1
        Next
    End With

End Sub
[

[此贴子已经被作者于2006-10-26 21:24:56编辑过]

方漠

改为如下代码试下:
Select Case CEL.Value
        Case Is < 0.9
              .Points(i).Interior.ColorIndex = 4  
        Case is <1.05
              .Points(i).Interior.ColorIndex = 27
        Case else
              .Points(i).Interior.ColorIndex = 3
  End Select

ppsnow

还是不对啊　　方漠大哥　１１１１

ppsnow

改了你写的那段后还是不对，，，，，，，，，，，，，，，，

如图所示，颜色还是乱来的，，，，

方漠

另下次发附件请放在前面，我用的IE7这个论坛不能正常显示，要跑去FIREFOX下看，郁闷得很的是FIREFOX回贴在此论坛又不能附上附件。

ppsnow

先谢谢方漠大哥，，，，，

我去掉了小勾，也保存了修改，可是当我重新测试时，（换部门，或换时间短） 又会发现小勾又自动勾上了，怎么回事呢，测试来测试去还是颜色乱的，，，，唉，，，，

ppsnow

晕，每次小勾都自己勾上了，，，颜色有时对时错，，，

真是累人，，，



else：那为什么还要用那个浏览器啊，，重装别的浏览器就好了阿，，，，，

ppsnow

不知不觉已经12点了，做这种工作真是bittersweet,but 女生不适合做这种，，，累人啊，，，还好只是实习，，，

方漠

Private Sub CommandButton2_Click()
Dim ICol, JCol As Integer
Dim myRange, CRange As Range

If Range("26") <= Range("N26") Then
   MsgBox "The Beginning date must less than the End date! Please choose again!", vbCritical
   Exit Sub
End If

  Set myRange = ActiveSheet.Range("A21:BC21")
  ICol = Application.WorksheetFunction.Match(Range("N26"), myRange)
  JCol = Application.WorksheetFunction.Match(Range("26"), myRange)
   
  Set CRange = Range(ActiveSheet.Cells(21, ICol), ActiveSheet.Cells(22, JCol))
  ActiveSheet.ChartObjects("Chart 4").Activate
  ActiveChart.SetSourceData Source:=CRange, PlotBy:=xlRows
  
  With ActiveChart
        .HasTitle = False
        .HasLegend = False
      With .ChartGroups(1)
        .Overlap = 0
        .GapWidth = 2
        .VaryByCategories = True              '将此句去掉或改成FALSE.
        
      End With
  End With

'Range("G26").Select

End Sub

ppsnow

谢谢你了，　每次都是你来帮我，

是这样加吗，测试后还是不对，，问题是不是不在此啊，　因为程序中去掉了分点变色，　但是在那个窗体里，小勾还是在的，

Sub Chartcolor1()

  

  Dim ICol, JCol As Integer
  Dim myRange, CRange As Range

  
  Set myRange = ActiveSheet.Range("A21:BC21")
  ICol = Application.WorksheetFunction.Match(Range("N26"), myRange)
  JCol = Application.WorksheetFunction.Match(Range("26"), myRange)
   
  Set CRange = Range(ActiveSheet.Cells(22, ICol), ActiveSheet.Cells(22, JCol))
  ActiveSheet.ChartObjects("Chart 4").Activate
  ActiveChart.SetSourceData Source:=CRange, PlotBy:=xlRows
  
  With ActiveChart
        .HasTitle = False
        .HasLegend = False
      With .ChartGroups(1)
        .Overlap = 0
        .GapWidth = 2
        .VaryByCategories = False
        
      End With
  End With

i = 1
ActiveSheet.ChartObjects(2).Activate
    With ActiveChart.SeriesCollection(1)
        For Each CEL In CRange 'Range("b22:bc22")
            Select Case CEL.Value
                 Case Is < 0.9
              .Points(i).Interior.ColorIndex = 4  'green
                Case 0.9 To 1.05
              .Points(i).Interior.ColorIndex = 27 'yellow这里我改回来的，不过改和不改一样的，
                Case Else
              .Points(i).Interior.ColorIndex = 3  'red

            End Select
            i = i + 1
        Next
    End With

End Sub