目標區域中有隱藏行、列Excel 黏貼數據時如何跳過隱藏區域

應用場景

將excel黏貼時僅僅黏貼在顯示的單元格中(當目標區域中有隱藏行、列、或者目標區域處于篩選狀態,excel黏貼數據時不會跳過隱藏區域)

知識要點

1：SpecialCells(xlCellTypeVisible)  定位可見區域，

2：如果被復制區域有隱藏區域，那么創建一個輔助工作表，將被復制區域的可見區域黏貼到輔助工作表

3：黏貼后的區域不在存在隱藏區域，然后將選區的單元格逐個復制到目標區域，在復制時檢查它的狀態是否為顯示

Sub 黏貼數據時跳過隱藏區()

        Dim Rng As Range, Rngg As Range, Cell As Range, i As Long, Rang As Range, Sht As Worksheet, j As Integer, Col_count As Integer

        On Error Resume Next

        If TypeName(Selection) = "Range" Then  '僅僅對選擇對象是單元格者進行操作

            Set Sht = ActiveSheet   '將當前工作表賦值給變量sht

            '確定黏貼的目標區域

            Set Cell = Application.InputBox("請選擇目標區域存放區域，一個單元格即可", "目標區域", , , , , , 8)

            If Err <> 0 Then Exit Sub '如果有錯誤則退出

            Application.ScreenUpdating = False  '關閉屏幕刷新

            With Selection.SpecialCells(xlCellTypeVisible) '定位選區的可見區域

                If .Address <> Selection.Address Then

                '如果可見區域地址與選區的地址不一致

                    Selection.SpecialCells(xlCellTypeVisible).Copy  '復制選區的可見區域

                    Sheets.Add after:=Sheets(Sheets.Count) '添加一個新表

                    ActiveSheet.Paste '黏貼數據

                    Set Rngg = Selection '將新表中的選區賦予變量

                Else

                    Set Rngg = Selection

                End If

            End With

            Sht.Select '返回原工作表

            '確定目標區域列數

            For i = 1 To 5000 '循環

                '如果目標存放區域的第一個單元格向右偏移 i-1 的單元格的列寬大于（也就是說顯示狀態）

                If Cell.Offset(0, i - 1).ColumnWidth > 0 Then

                    Col_count = Col_count + 1 '那么累加計數器，該計數器代表顯示區域的列數

                    '如果計數器等于rngg區域的列數時，終止循環

                    If Col_count = Rngg.Columns.Count Then GoTo begin

                End If

            Next i

            '開始復制選區中可見單元格到目標區域中的可見單元格中

begin:

            Set Cell = Cell.Resize(Rngg.Rows.Count, i)

            '根據rngg的列數和變量i重新指定cell代表的區域

            For Each Rng In Rngg '遍歷rngg區域(外層循環)

                For i = 1 To 5000

                    '如果cell區域的j +1 個單元格為顯示狀態，那么終止里層循環

                    If Cell(j + i).RowHeight > 0 And Cell(j + i).ColumnWidth > 0 Then GoTo Star

                Next

Star:

                    j = j + 1 '累加變量

                    Rng.Copy Cell(j) '逐個復制單元格

            Next Rng

            If Selection.SpecialCells(xlCellTypeVisible).Address <> Selection.Address Then

                Application.DisplayAlerts = False

                Sheets(Sheets.Count).Delete

                Application.DisplayAlerts = True

            End If

            Application.ScreenUpdating = True

        End If

End Sub

版權聲明：本文內容由網絡用戶投稿，版權歸原作者所有，本站不擁有其著作權，亦不承擔相應法律責任。如果您發現本站中有涉嫌抄襲或描述失實的內容，請聯系我們jiasou666@gmail.com 處理，核實后本網站將在24小時內刪除侵權內容。