[已解决]循环标红单元格

cunfu2010

附件和截图都上传不了，做了个样式图，见谅。
用InputBox确定第一个要标红的单元格，后面的间隔13，依次标红，结果样式见下图。

1月1日	1月2日	1月3日	1月4日	1月5日	1月6日	1月7日	1月8日	1月9日	1月10日
1月11日	1月12日	1月13日	1月14日	1月15日	1月16日	1月17日	1月18日	1月19日	1月20日
1月21日	1月22日	1月23日	1月24日	1月25日	1月26日	1月27日	1月28日	1月29日	1月30日
1月31日	2月1日	2月2日	2月3日	2月4日	2月5日	2月6日	2月7日	2月8日	2月9日
2月10日	2月11日	2月12日	2月13日	2月14日	2月15日	2月16日	2月17日	2月18日	2月19日
2月20日	2月21日	2月22日	2月23日	2月24日	2月25日	2月26日	2月27日	2月28日	2月29日
3月1日	3月2日	3月3日	3月4日	3月5日	3月6日	3月7日	3月8日	3月9日	3月10日
3月11日	3月12日	3月13日	3月14日	3月15日	3月16日	3月17日	3月18日	3月19日	3月20日
3月21日	3月22日	3月23日	3月24日	3月25日	3月26日	3月27日	3月28日	3月29日	3月30日
3月31日	4月1日	4月2日	4月3日	4月4日	4月5日	4月6日	4月7日	4月8日	4月9日
4月10日	4月11日	4月12日	4月13日	4月14日	4月15日	4月16日	4月17日	4月18日	4月19日
4月20日	4月21日	4月22日	4月23日	4月24日	4月25日	4月26日	4月27日	4月28日	4月29日
4月30日	5月1日	5月2日	5月3日	5月4日	5月5日	5月6日	5月7日	5月8日	5月9日
5月10日	5月11日	5月12日	5月13日	5月14日	5月15日	5月16日	5月17日	5月18日	5月19日
5月20日	5月21日	5月22日	5月23日	5月24日	5月25日	5月26日	5月27日	5月28日	5月29日
5月30日	5月31日	6月1日	6月2日	6月3日	6月4日	6月5日	6月6日	6月7日	6月8日
6月9日	6月10日	6月11日	6月12日	6月13日	6月14日	6月15日	6月16日	6月17日	6月18日
6月19日	6月20日	6月21日	6月22日	6月23日	6月24日	6月25日	6月26日	6月27日	6月28日
6月29日	6月30日	7月1日	7月2日	7月3日	7月4日	7月5日	7月6日	7月7日	7月8日
7月9日	7月10日	7月11日	7月12日	7月13日	7月14日	7月15日	7月16日	7月17日	7月18日
7月19日	7月20日	7月21日	7月22日	7月23日	7月24日	7月25日	7月26日	7月27日	7月28日
7月29日	7月30日	7月31日	8月1日	8月2日	8月3日	8月4日	8月5日	8月6日	8月7日
8月8日	8月9日	8月10日	8月11日	8月12日	8月13日	8月14日	8月15日	8月16日	8月17日
8月18日	8月19日	8月20日	8月21日	8月22日	8月23日	8月24日	8月25日	8月26日	8月27日
8月28日	8月29日	8月30日	8月31日	9月1日	9月2日	9月3日	9月4日	9月5日	9月6日
9月7日	9月8日	9月9日	9月10日	9月11日	9月12日	9月13日	9月14日	9月15日	9月16日
9月17日	9月18日	9月19日	9月20日	9月21日	9月22日	9月23日	9月24日	9月25日	9月26日
9月27日	9月28日	9月29日	9月30日	10月1日	10月2日	10月3日	10月4日	10月5日	10月6日
10月7日	10月8日	10月9日	10月10日	10月11日	10月12日	10月13日	10月14日	10月15日	10月16日
10月17日	10月18日	10月19日	10月20日	10月21日	10月22日	10月23日	10月24日	10月25日	10月26日
10月27日	10月28日	10月29日	10月30日	10月31日	11月1日	11月2日	11月3日	11月4日	11月5日
11月6日	11月7日	11月8日	11月9日	11月10日	11月11日	11月12日	11月13日	11月14日	11月15日
11月16日	11月17日	11月18日	11月19日	11月20日	11月21日	11月22日	11月23日	11月24日	11月25日
11月26日	11月27日	11月28日	11月29日	11月30日	12月1日	12月2日	12月3日	12月4日	12月5日
12月6日	12月7日	12月8日	12月9日	12月10日	12月11日	12月12日	12月13日	12月14日	12月15日
12月16日	12月17日	12月18日	12月19日	12月20日	12月21日	12月22日	12月23日	12月24日	12月25日
12月26日	12月27日	12月28日	12月29日	12月30日	12月31日

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-7-18 11:17

cunfu2010 发表于 2016-7-18 10:54
按这段代码，第一个标红与第二个标红之间是12个，后面的全是13个，怎么改进

x初始化为-1，之前倒也没考虑到这个问题：

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim i%, j%, t As Date, x%, b As Boolean, rng As Range
   
3.     If Target.Address <> "$A$1" Then Exit Sub
   
4.     If Target = "" Then Exit Sub
   
5.     t = CDate(Target.Value - 1 & "-12-31")
   
6.     j = 1
   
7.     Set rng = Application.InputBox(Prompt:="请选择起始单元格", Title:="选择单元格", Type:=8)
   
8.     rng.Interior.Color = 255
   
9.     x = -1
   
10.     Do
    
11.         j = j + 1
    
12.         For i = 1 To 10
    
13.             t = t + 1
    
14.             If Year(t) <> Target.Value Then Exit Sub
    
15.             Cells(j, i) = t
    
16.             If Cells(j, i).Interior.Color = 255 Then b = True
    
17.             If b = True Then x = x + 1
    
18.             If x <> 0 And x Mod 14 = 0 Then Cells(j, i).Interior.Color = 255
    
19.         Next
    
20.     Loop While Year(t) = Target.Value
    
21. End Sub

复制代码

跳转到最佳答案楼层

老司机带带我

按照你之前的贴，加了个inputbox:

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim i%, j%, t As Date, x%, b As Boolean, rng As Range
   
3.     If Target.Address <> "$A$1" Then Exit Sub
   
4.     If Target = "" Then Exit Sub
   
5.     t = CDate(Target.Value - 1 & "-12-31")
   
6.     j = 1
   
7.     Set rng = Application.InputBox(Prompt:="请选择起始单元格", Title:="选择单元格", Type:=8)
   
8.     rng.Interior.Color = 255
   
9.     Do
   
10.         j = j + 1
    
11.         For i = 1 To 10
    
12.             t = t + 1
    
13.             If Year(t) <> Target.Value Then Exit Sub
    
14.             Cells(j, i) = t
    
15.             If Cells(j, i).Interior.Color = 255 Then b = True
    
16.             If b = True Then x = x + 1
    
17.             If x <> 0 And x Mod 14 = 0 Then Cells(j, i).Interior.Color = 255
    
18.         Next
    
19.     Loop While Year(t) = Target.Value
    
20. End Sub

复制代码

cunfu2010

老司机带带我 发表于 2016-7-18 10:34
按照你之前的贴，加了个inputbox:

按这段代码，第一个标红与第二个标红之间是12个，后面的全是13个，怎么改进

老司机带带我

cunfu2010 发表于 2016-7-18 10:54
按这段代码，第一个标红与第二个标红之间是12个，后面的全是13个，怎么改进

x初始化为-1，之前倒也没考虑到这个问题：

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim i%, j%, t As Date, x%, b As Boolean, rng As Range
   
3.     If Target.Address <> "$A$1" Then Exit Sub
   
4.     If Target = "" Then Exit Sub
   
5.     t = CDate(Target.Value - 1 & "-12-31")
   
6.     j = 1
   
7.     Set rng = Application.InputBox(Prompt:="请选择起始单元格", Title:="选择单元格", Type:=8)
   
8.     rng.Interior.Color = 255
   
9.     x = -1
   
10.     Do
    
11.         j = j + 1
    
12.         For i = 1 To 10
    
13.             t = t + 1
    
14.             If Year(t) <> Target.Value Then Exit Sub
    
15.             Cells(j, i) = t
    
16.             If Cells(j, i).Interior.Color = 255 Then b = True
    
17.             If b = True Then x = x + 1
    
18.             If x <> 0 And x Mod 14 = 0 Then Cells(j, i).Interior.Color = 255
    
19.         Next
    
20.     Loop While Year(t) = Target.Value
    
21. End Sub

复制代码

cunfu2010

老司机带带我 发表于 2016-7-18 11:17
x初始化为-1，之前倒也没考虑到这个问题：

这次好了，谢谢！