vba判断某一行是否添加自动筛选

方法/步骤如下：

1/7分步阅读

1.用VBA程序处理Excel数据文件，用户的数据文件有时处于自动筛选模式，为此，需要检测工作表是否处于该模式，则去掉自动筛选，代码如下：

2/7

2.虽然Selection.AutoFilter也可以加上自动筛选，但筛选位置却可能在当前单元格处，所以要注意，加自动筛选前，现将单元格定位到字段标题处代码

3/7

3.检测其它非活跃的工作表代码

4/7

4.语法错误数据

5/7

5.数据表格显示结果：

6/7

6.返回的数据

7/7

7.Visual Basic for Applications方法代码

以下是可以实现上述条件的示例代码：

Sub CopyData()

Dim i As Integer, j As Integer, lastRow As Integer, targetSheet As Worksheet

javaCopy codelastRow = Cells(Rows.Count, "H").End(xlUp).RowFor i = 1 To lastRow

If Cells(i, 8).Value = 4 Then

If Cells(i + 1, 8).Value >= 5 And Cells(i + 2, 8).Value <= 4 ThenSet targetSheet = Worksheets("A")

targetSheet.Range("F" &targetSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 &":H" &targetSheet.Cells(Rows.Count, "A").End(xlUp).Row + 2).Value = Range("F" &i &":H" &i + 2).Value

End If

End If

Next ilastRow = Cells(Rows.Count, "L").End(xlUp).RowFor i = 1 To lastRow

If Cells(i, 12).Value = 4 Then

If Cells(i + 1, 12).Value >= 5 And Cells(i + 2, 12).Value >= 5 And Cells(i + 3, 12).Value <= 4 ThenSet targetSheet = Worksheets("B")

targetSheet.Range("J" &targetSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1 &":L" &targetSheet.Cells(Rows.Count, "B").End(xlUp).Row + 3).Value = Range("J" &i &":L" &i + 3).Value

End If

End If

Next ilastRow = Cells(Rows.Count, "P").End(xlUp).RowFor i = 1 To lastRow

If Cells(i, 16).Value = 4 Then

If Cells(i + 1, 16).Value >= 5 And Cells(i + 2, 16).Value >= 5 And Cells(i + 3, 16).Value >= 5 And Cells(i + 4, 16).Value <= 4 ThenSet targetSheet = Worksheets("C")

targetSheet.Range("N" &targetSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1 &":P" &targetSheet.Cells(Rows.Count, "C").End(xlUp).Row + 4).Value = Range("N" &i &":P" &i + 4).Value

End If

End If

Next ilastRow = Cells(Rows.Count, "T").End(xlUp).RowFor i = 1 To lastRow

If Cells(i, 20).Value = 4 Then

If Cells(i + 1, 20).Value >= 5 And Cells(i + 2, 20).Value >= 5 And Cells(i + 3, 20).Value >= 5 And Cells(i + 4, 20).Value >= 5 And Cells(i + 5, 20).Value <= 4 ThenSet targetSheet = Worksheets("D")

targetSheet

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = 2 And Target.Column = 6 Then

If Application.WorksheetFunction.CountIf(Sheets("表2").Range("a:a"), Sheets("表1").Cells(2, 6)) = 0 Then

UserForm1.Show

End If

End If

End Sub

以上是表1里面change事件控制单元格在表2是否存在

下面是按钮代码和一个窗体代码激活代码

Private Sub CommandButton1_Click()

If Sheets("表2").UsedRange.Rows.Count = 1 Then

Sheets("表2").Cells(2, 1) = Me.TextBox1.Text

Sheets("表2").Cells(2, 2) = Me.TextBox2.Text

Sheets("表2").Cells(2, 3) = Me.TextBox3.Text

Me.TextBox1.Locked = False

Me.TextBox1.Text = ""

Me.TextBox2.Text = ""

Me.TextBox3.Text = ""

UserForm1.Hide

Else

Sheets("表2").Cells(Sheets("表2").UsedRange.Rows.Count + 1, 1) = Me.TextBox1.Text

Sheets("表2").Cells(Sheets("表2").UsedRange.Rows.Count + 1, 2) = Me.TextBox2.Text

Sheets("表2").Cells(Sheets("表2").UsedRange.Rows.Count + 1, 3) = Me.TextBox3.Text

Me.TextBox1.Locked = False

Me.TextBox1.Text = ""

Me.TextBox2.Text = ""

Me.TextBox3.Text = ""

UserForm1.Hide

End If

End Sub

Private Sub UserForm_Activate()

Me.TextBox1 = Sheets("表1").Cells(2, 6)

Me.TextBox1.Locked = True

End Sub

不知道有没帮助  有需要邮件我  我把附件发给你吧

结合起来看 呵呵 我测试好好 没大问题 ~

---