Question

我确信这是一个相对简单的查询，但是说我是VBA的业余爱好者会是一种恭维。

我要做的是使用宏按钮将某些信息从一张纸复制到主表。这工作正常，直到我隐藏行（总共有880行，并且假设它们与数据输入表并排放置，我有点需要隐藏它们以便于导航）。

这是我目前使用的代码 - 是否可以修改以包含隐藏的行？

提前谢谢你，

罗布

Private Sub CopyDataTeam1()
    Application.ScreenUpdating = False
    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet

    Set copySheet = ActiveSheet
    Set pasteSheet = Worksheets("MainData")

    copySheet.Range("AY5:BC5", copySheet.Range("AY5:BC5").End(xlDown)).Copy
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

    Sheets("MainData").Cells.Replace What:="-", Replacement:="", LookAt:=xlWhole, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Answer 1

一种解决方案可能是首先检查您的工作表是否有隐藏的行。将其存储到Range对象。

取消隐藏你的射程，做你的东西，然后重新隐藏你的射程...

'pass in a worksheet, and get all the hidden rows
Function HiddenRange(ws As Worksheet) As Range

Dim hideRange As Range
Dim column As Long

    'use column a
    column = 1

'if your hidden rows are at the end of your sheet, then 
'.End(xlUp) may not capture the end of the sheet correctly.
'could use UsedRange.Rows instead..
For i = 1 To ws.UsedRange.Rows.Count 'ws.Cells(ws.Rows.Count, column).End(xlUp).Row

    If ws.Rows(i).Hidden Then

        If hideRange Is Nothing Then

        Set hideRange = ws.Rows(i)

        Else

        Set hideRange = Application.Union(ws.Rows(i), hideRange)

        End If

    End If

Next i

'return our hidden range
    If hideRange Is Nothing = False Then

    Set HiddenRange = hideRange

    End If

End Function


Public Sub UsageExample()

Dim rng As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'disable error tracking as we get type mismatch if rng is set to nothing
On Error Resume Next
Set rng = HiddenRange(Sheet1)

'resume error handling
On Error GoTo err


If Not rng Is Nothing Then rng.Rows.Hidden = False


'do your stuff in here

If Not rng Is Nothing Then rng.Rows.Hidden = True


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Exit Sub

err:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox err.Description, vbExclamation, "An error occured"

End Sub

您可能还想更改设置复印范围的方式。不要使用xlDown，就像在BC列中有任何空白单元格一样，范围将无法正确设置。

将其更改为以下内容将根据列BC

中的最低值设置范围

copySheet.Range(copySheet.Range("AY5"), copySheet.Range("BC" & copySheet.Rows.Count).End(xlUp)).Copy

需要Excel VBA /宏辅助 - 隐藏行

1 个答案: