Private Sub BeginIt_Click()
Dim JudgeTrue As Boolean
Dim CellVar As Range, FindingCell As Range, BlankCell As Range, SearchScope As Range
Dim Gave As String, BeGiven As Range
Dim FoundRow As Long, EndRow As Long, BeginRow As Long, RowRange As Long, CurRowOrder As Long, FirstBlankPos As Long
Dim BeginCol As Long, EndCol As Long, ColRange As Long
Dim StrForSearch As String
Dim OptionObj As Object
If (FileName1.ListIndex < 0) Or (FileName2.ListIndex < 0) Then
MsgBox "先选择要比较的工作表！", vbCritical, "错误"
Exit Sub
End If
If CopyTo.Value And (CopyToWbLocation.ListIndex < 0) Then
MsgBox "先选择抄写的目的位置！", vbCritical, "错误"
Exit Sub
End If
If (IsFound.ListIndex < 0) Or (IsInclude.ListIndex < 0) Then
MsgBox "选择一个筛选条件！", vbCritical, "错误"
Exit Sub
End If
If CatNo1.Value = ColNum1.Value Or CatNo2.Value = ColNum1.Value Then
MsgBox "参数列和抄写列或欲写入列不能相同！", vbCritical, "错误"
Exit Sub
End If
If CopyTo.Value Then
With Workbooks(CopyToWbLocation.Text).Sheets(CopyToWsLocation.Text)
FirstBlankPos = .UsedRange.Row + .UsedRange.Rows.Count
End With
End If
With Workbooks(FileName1.Text).Worksheets(Sheet1.ListIndex + 1)
BeginRow = .UsedRange.Row
EndRow = .UsedRange.Row + .UsedRange.Rows.Count
RowRange = EndRow - BeginRow
CurRowOrder = 1
BeginCol = .UsedRange.col
EndCol = .UsedRange.col + .UsedRange.Columns.Count
ColRange = EndCol - BeginCol
If CompByCol1.Value Then
Set SearchScope = .Range(.Cells(BeginRow, CatNo1.Value), .Cells(EndRow - 1, CatNo1.Value))
Else
Set SearchScope = .Range(.Cells(CatNo1.Value, BeginCol), .Cells(CatNo1.Value, EndCol - 1))
End If
For Each CellVar In SearchScope
If Not (IgnoreBlank.Value And CellVar.Value = "") Then
Select Case IsInclude.ListIndex
Case 0
StrForSearch = CellVar.Value
Case 1
StrForSearch = "*" & CellVar.Value & "*"
Case 2
StrForSearch = CellVar.Value & "*"
Case 3
StrForSearch = "*" & CellVar.Value
End Select
If CompByCol2.Value Then
Set FindingCell = Workbooks(FileName2.Text).Worksheets(Sheet2.ListIndex + 1).Columns(CatNo2.Value).Find(what:=StrForSearch, lookat:=xlWhole)
Else
Set FindingCell = Workbooks(FileName2.Text).Worksheets(Sheet2.ListIndex + 1).Rows(CatNo2.Value).Find(what:=StrForSearch, lookat:=xlWhole)
End If
If (IsFound.ListIndex = 0) Then
JudgeTrue = (Not FindingCell Is Nothing)
Else
JudgeTrue = (FindingCell Is Nothing)
End If
If CompByCol1.Value Then
Set BeGiven = .Cells(CellVar.Row, ColNum1.Value)
Else
Set BeGiven = .Cells(ColNum1.Value, CellVar.Column)
End If
If CompByCol2.Value Then
Gave = Workbooks(FileName2.Text).Worksheets(Sheet2.ListIndex + 1).Cells(FindingCell.Row, ColNum2.Value).Value
Else
Gave = Workbooks(FileName2.Text).Worksheets(Sheet2.ListIndex + 1).Cells(ColNum2.Value, FindingCell.Column).Value
End If
If JudgeTrue Then
If CopyContent.Value Then
If Not (BeGiven.Value <> "" And IgnoreNoBlank.Value) Then BeGiven.Value = Gave
End If
If WriteLabel.Value Then
If Not (BeGiven.Value <> "" And IgnoreNoBlank.Value) Then BeGiven.Value = DiffLabel.Text
End If
If CopyTo.Value Then
With Workbooks(CopyToWbLocation.Text).Sheets(CopyToWsLocation.Text).Cells(FirstBlankPos, SetCopyCol.Value)
If Not (.Value <> "" And IgnoreNoBlank.Value) Then .Value = Gave
End With
FirstBlankPos = FirstBlankPos + 1
End If
If WriteNote.Value Then
With BeGiven
If Not (.Comment <> "" And IgnoreNoBlank.Value) Then
.AddComment
.Text Text:=NoteContentPrefix.Text & VBA.IIf(IncludeCopyContent.Value, Gave, "") & NoteContentSuffix.Text
.Visible = ShowNotes.Value
End With
End With
End If
End If
DoEvents
StatusBar.Caption = "已完成" & CurRowOrder & "/" & RowRange & "，共占约" & Format(CurRowOrder / RowRange, "###.00%")
CurRowOrder = CurRowOrder + 1
End If
Next
End With
MsgBox "已经结束！" & vbCr & "共处理了" & RowRange & "条内容。", vbInformation, "信息"
StatusBar.Caption = "等待您的命令..."
End Sub
