Question

在excel2003中请VBA高手编写如下图片中要求的VBA代码，谢谢！

Answer 1

一个简单的 条件格式 公式 不就搞定了么 ，不需要用宏， 用宏 也可以直接录 那条件格式公式

选中B列 ，条件格式 ，使用公式：
=and(ABS(B1-B2)=1,ABS(B2-B3)=1,ABS(B1-B3)=2)
格式 填充 选 黄色 ， 就标记好了

追问

你好，你的公式我试了，选了颜色，没有颜色标记，而且我就是觉得VBA更方便些，谢谢！

追答

宏：

Sub 填色()
 For i = 10 To [b65536].End(xlUp).Row
   If Abs(Cells(i, "B") - Cells(i + 1, "B")) = 1 And Abs(Cells(i, "B") - Cells(i + 2, "B")) = 2 And Abs(Cells(i + 2, "B") - Cells(i + 1, "B")) = 1 Then
    Range(Cells(i, "B"), Cells(i + 2, "B")).Interior.Color = vbYellow
   End If
  Next
End Sub

 

写错了 个字：

Sub 填色()
 For i = 10 To [b65536].End(xlUp).Row
   If Abs(Cells(i, "B") - Cells(i + 1, "B")) = 1 And Abs(Cells(i, "B") - Cells(i + 2, "B")) = 2 And Abs(Cells(i + 2, "B") - Cells(i + 1, "B")) = 1 Then
    Range(Cells(i, "B"), Cells(i + 2, "B")).Interior.Color = vbYellow
   End If
  Next
End Sub

 

追问

很好的，我是excel2003，就是为什么三个数的等差不显示标记颜色？图片中的B8-10，(1，2，3)不显示颜色标记，如下图片

追答

我看错了，以为你是从第10行开始的， 把 for i=10  改成 7 就可以了

Sub 填色()
 For i = 7 To [b65536].End(xlUp).Row  '这里的 10 改成 7
   If Abs(Cells(i, "B") - Cells(i + 1, "B")) = 1 And Abs(Cells(i, "B") - Cells(i + 2, "B")) = 2 And Abs(Cells(i + 2, "B") - Cells(i + 1, "B")) = 1 Then
    Range(Cells(i, "B"), Cells(i + 2, "B")).Interior.Color = vbYellow
   End If
  Next
End Sub

追问

高手，颜色填充没问题了，就是能不能， 按我先选中范围后，再执行范围内的查找和标记颜色呢？（就是选中多大的范围，就在多大的范围内查找和标记颜色）

追答

可以

Sub 填色()
Dim i As Range
 For Each i In Selection
   If Abs(i.Offset(1) - i) = 1 And Abs(i.Offset(2) - i) = 2 And Abs(i.Offset(2) - i.Offset(1)) = 1 Then
    i.Resize(3).Interior.Color = vbYellow
   End If
  Next
End Sub

追问

真是太厉害了，高手，我还想问你最后一个问题，就是，如果我想找等差数为正负+-2的数组，要怎么稍微改一下代码呢？

追答

1  改成2  ，2 改成 4 

Sub 填色()
Dim i As Range
 For Each i In Selection
   If Abs(i.Offset(1) - i) = 2 And Abs(i.Offset(2) - i) = 4 And Abs(i.Offset(2) - i.Offset(1)) = 2 Then
    i.Resize(3).Interior.Color = vbYellow
   End If
  Next
End Sub

Answer 2

Public Sub lianshu(row_n, col_n, n, sheet_n) '给出所在首行，列，数据个数以及表格位置
Dim flag As Boolean
Dim chazhi
Dim i As Integer
chazhi = Worksheets(sheet_n).Range(Chr(96 + col_n) & (row_n)).Value
For i = row_n + 1 To n
If Abs(Worksheets(sheet_n).Range(Chr(96 + col_n) & (i)).Value - chazhi) = 1 Then
Worksheets(sheet_n).Range(Chr(96 + col_n) & (i-1)).Font.Bold = True
Worksheets(sheet_n).Range(Chr(96 + col_n) & (i)).Font.Bold = True

End If
chazhi = Worksheets(sheet_n).Range(Chr(96 + col_n) & (i)).Value

Next i
End Sub