VBA代码不会查看隐藏的行以添加具有跟踪编号的行

Question

我有另一个问题,我希望在你的帮助下解决.

我想做什么 我使用Excel来跟踪我的工作,活动,联系人等等.在这样做的同时,我发现在一个名为"活动"的工作表末尾添加行时,我做了大量的重复工作.

我想要做的是: - 按一个按钮并添加一行. - 使用1增加trackingnumber - 插入默认值

代码. 为了自动执行此操作,我找到了(复制,粘贴,根据我的需要调整它)以下代码:

 Sub AddRowActiviteiten_NewAtEnd()
'Add's a new row at the end of the sheet.

Dim wsActiviteiten As Worksheet
Set wsActiviteiten = Sheets("Activiteiten")

DefType = "Daily"
DefStatus = "Open"
DefIssue = "*****"
DefImpact = "*****"
DefPrio = "Laag"
MyDate = Date

wsActiviteiten.Range("A4").Value = "1"

'Copy the "One Row To Rule Them All"
wsActiviteiten.Range("A3:Q3").Copy

wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)

'Stop the "copy-action"
Application.CutCopyMode = False

'Increase the tracking number with "one"
LastNumber = wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Value
wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = LastNumber + 1

'Insert default values
LastRow = wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(-1, 0).Row
Cells(LastRow + 1, 2) = DefType
Cells(LastRow + 1, 3) = DefStatus
Cells(LastRow + 1, 4) = DefIssue
Cells(LastRow + 1, 5) = DefImpact
Cells(LastRow + 1, 6) = DefPrio
Cells(LastRow + 1, 8) = MyDate

'Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select

End Sub

问题. 在这张表中,我打开了新项目,但我也关闭它们.我这样做是通过改变他们的状态并将他们隐藏起来的.这就是出错的地方.当我关闭列表中的最后一项并想要添加新行时,宏会在最后一个可见条目下添加一个新行.它没有找到我刚刚隐藏的最后一个条目.而且,当发生这种情况时,将默认值添加到新行不起作用.它将它们添加到添加的行上方的行中.

不知怎的,这很有道理.我告诉宏寻找最后一个条目,但我不明白为什么它会查看最后一个可见条目以及它为什么不查看隐藏的行.

要复制.将代码复制到工作表中(可能需要更改工作表的名称)并添加几行.将一些信息放在最后一行并隐藏它.再添几行,看看会发生什么.

解决方案.有办法解决这个问题吗？也许有一种更聪明的做事方式？我调查了一些事情,但主要是我使用"("A"&Rows.Count).End(xlUp)"得到了结果.一个循环可以工作,但我担心1)它不搜索隐藏的行和2)它使表(有点)缓慢.我必须说我试图制作一个循环,首先我想看看我的第一个解决方案是否可以挽救.

感谢您的意见,如有任何疑问请告诉我.

Simon EDIT:感兴趣的人的工作代码

  Sub AddRowActiviteiten_NewAtEnd()
'Add's a new row at the end of the sheet.

Dim wsActiviteiten As Worksheet
Set wsActiviteiten = Sheets("Activiteiten")

DefType = "Daily"
DefStatus = "Open"
DefIssue = "*****"
DefImpact = "*****"
DefPrio = "Laag"
MyDate = Date

'Copy the One Row To Rule Them All
wsActiviteiten.Range("A3:Q3").Copy

'Offset(y,x)
'De -16 is een getal dat iets doet, maar ik weet niet wat.
wsActiviteiten.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(1, -16).PasteSpecial (xlPasteAll)

'Stop the "copy-action"
Application.CutCopyMode = False

'Het volgnummer verhogen met 1
'Het laatste getal selecteren (LastNumber) en dan plus 1.
LastNumber = wsActiviteiten.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(0, -16).Value
wsActiviteiten.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(1, -16).Value = LastNumber + 1

'Insert default values
LastRow = wsActiviteiten.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(-1, 0).Row
Cells(LastRow + 1, 2) = DefType
Cells(LastRow + 1, 3) = DefStatus
Cells(LastRow + 1, 4) = DefIssue
Cells(LastRow + 1, 5) = DefImpact
Cells(LastRow + 1, 6) = DefPrio
Cells(LastRow + 1, 8) = MyDate

'Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select

End Sub

Answer 1

更新

我看到您的工作表有一个自动过滤器“隐藏”状态行 -Find与隐藏行不同，它不会检测到。

建议您尝试下面的更新代码：

Sub Test()

Dim rng1 As Range
If ActiveSheet.AutoFilterMode Then
    MsgBox ActiveSheet.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Row
Else
    Set rng1 = Columns("A:A").Find("*", [a1], xlFormulas, , xlByRows, xlPrevious)
    If Not rng1 Is Nothing Then MsgBox rng1.Row
End If
End Sub

初始帖子

如果您要隐藏行，则可以使用Find该xlFormulas选项来查找隐藏行中的条目（与 不同xlValues）。

Dim rng1 As Range
Set rng1 = Columns("A:A").Find("*", [a1], xlFormulas, , xlByRows, xlPrevious)
MsgBox rng1.Address