'工程->引用Microsoft Excel x.0 Object Library Private Sub Command1_Click() Dim mFind, FirstAddress Dim mCount As Integer Dim mRemRow Dim mSaveFind() As Long Dim mContRow As Long Dim i As LongDim mRange As Range Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类 xlApp.Visible = True '设置EXCEL可见 Set xlBook = xlApp.Workbooks.Open(App.Path & "\Book1.xls") '打开EXCEL工作簿 Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表 xlsheet.Activate '激活工作表 xlsheet.Range("A2:I15").Select With xlsheet.Range("A2:I15") Set mFind = xlsheet.Cells.Find(What:=5, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=True) If Not mFind Is Nothing Then mCount = 1 mContRow = 0 mRemRow = mFind.Row FirstAddress = mFind.Address Do If mRemRow = mFind.Row And mCount < 8 Then mCount = mCount + 1 Else If mRemRow = mFind.Row And mCount = 8 Then ReDim Preserve mSaveFind(mContRow) mSaveFind(mContRow) = mFind.Row mContRow = mContRow + 1 Else If mRemRow <> mFind.Row Then mCount = 1 mRemRow = mFind.Row End If End If End If Set mFind = .FindNext(mFind) Loop While mFind.Address <> FirstAddress End If End With If mContRow <> 0 Then Worksheets("sheet1").Activate Set mRange = Range("A" & CStr(mSaveFind(0)) & ":" & "I" & CStr(mSaveFind(0))) For i = 1 To UBound(mSaveFind()) Set mRange = Union(mRange, Range("A" & CStr(mSaveFind(i)) & ":" & "I" & CStr(mSaveFind(i)))) Next i mRange.Select Selection.Delete Shift:=xlUp End If xlBook.Close (True) '关闭EXCEL工作簿 xlApp.Quit '关闭EXCEL Set xlApp = Nothing '释放EXCEL对象 End Sub
'工程-〉引用Microsoft ActiveX Data Objects 2.x Library
Option Explicit
Public mCnnString As StringPrivate Sub Form_Load()
mCnnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source= " & App.Path & "\Book1.xls;" & "Extended Properties=""Excel 8.0;HDR=Yes;"";"
End SubPrivate Sub Command1_Click()
Dim mCon As New ADODB.Connection
Dim mRst As New ADODB.Recordset
Dim mField(8) As String
Dim i As Integer
mCon.CursorLocation = adUseClient
mCon.Open mCnnString
mRst.Open "Select * From [Sheet1$]", mCnnString, adOpenKeyset, adLockOptimistic, adCmdText
For i = 0 To mRst.Fields.Count - 1
mField(i) = mRst.Fields.Item(i).Name
Next i
mCon.Execute "Update [Sheet1$] Set " & mField(0) & " = Null ," & mField(1) & " = Null ," & mField(2) & " = Null ," & mField(3) & " = Null ," & mField(4) & " = Null ," & mField(5) & " = Null ," & mField(6) & " = Null ," & mField(7) & " = Null ," & mField(8) & " = Null " & "Where " & mField(0) & "= 5 And " & mField(1) & "= 5 And " & mField(2) & "= 5 And " & mField(3) & "= 5 And " & mField(4) & "= 5 And " & mField(5) & "= 5 And " & mField(6) & "= 5 And " & mField(7) & "= 5 And " & mField(8) & "= 5 "
Set mRst = Nothing
Set mCon = Nothing
End Sub
Private Sub Command1_Click()
Dim mFind, FirstAddress
Dim mCount As Integer
Dim mRemRow
Dim mSaveFind() As Long
Dim mContRow As Long
Dim i As LongDim mRange As Range
Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
xlApp.Visible = True '设置EXCEL可见
Set xlBook = xlApp.Workbooks.Open(App.Path & "\Book1.xls") '打开EXCEL工作簿
Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
xlsheet.Activate '激活工作表 xlsheet.Range("A2:I15").Select
With xlsheet.Range("A2:I15")
Set mFind = xlsheet.Cells.Find(What:=5, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=True)
If Not mFind Is Nothing Then
mCount = 1
mContRow = 0
mRemRow = mFind.Row
FirstAddress = mFind.Address
Do
If mRemRow = mFind.Row And mCount < 8 Then
mCount = mCount + 1
Else
If mRemRow = mFind.Row And mCount = 8 Then
ReDim Preserve mSaveFind(mContRow)
mSaveFind(mContRow) = mFind.Row
mContRow = mContRow + 1
Else
If mRemRow <> mFind.Row Then
mCount = 1
mRemRow = mFind.Row
End If
End If
End If
Set mFind = .FindNext(mFind)
Loop While mFind.Address <> FirstAddress
End If
End With If mContRow <> 0 Then
Worksheets("sheet1").Activate
Set mRange = Range("A" & CStr(mSaveFind(0)) & ":" & "I" & CStr(mSaveFind(0)))
For i = 1 To UBound(mSaveFind())
Set mRange = Union(mRange, Range("A" & CStr(mSaveFind(i)) & ":" & "I" & CStr(mSaveFind(i))))
Next i
mRange.Select
Selection.Delete Shift:=xlUp
End If
xlBook.Close (True) '关闭EXCEL工作簿
xlApp.Quit '关闭EXCEL
Set xlApp = Nothing '释放EXCEL对象
End Sub