一个简单的vba程序

阅读更多

1、实现一个基本的复制功能，办公室同事所需要的一个小功能。

Sub rep()
'
' rep Macro
' 宏由 sea gull 录制，时间: 2007-1-10
'

'
  Dim i As Integer
  Dim endrow As Integer
  endrow = Range("A65536").End(xlUp).Row

  For i = 2 To endrow

    If Cells(i, 2).Value = "" Then
      Cells(i, 2).Value = Cells(i, 3).Value
    End If

  Next

End Sub

2、检查身份证号码不为18位的单元格刷红：

Sub check18()
'
' check18 Macro
' 宏由 sea gull 录制，时间: 2007-1-10
'
'
Dim i As Integer
Dim endrow As Integer
endrow = Range("A65536").End(xlUp).Row
For i = 2 To endrow
  If Len(CStr(Cells(i, 3).Value)) <> 18 And Len(CStr(Cells(i, 3).Value)) <> 15 Then
      Cells(i, 3).Font.ColorIndex = 3
  End If
Next

End Sub