目標區(qū)域中有隱藏行、列Excel 黏貼數據時如何跳過隱藏區(qū)域（隱藏數據區(qū)域外的行列）

應用場景

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

知識要點

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

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

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

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

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

'確定黏貼的目標區(qū)域

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

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

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

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

If .Address <> Selection.Address Then

'如果可見區(qū)域地址與選區(qū)的地址不一致

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

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

ActiveSheet.Paste '黏貼數據

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

Else

Set Rngg = Selection

End If

End With

Sht.Select '返回原工作表

'確定目標區(qū)域列數

For i = 1 To 5000 '循環(huán)

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

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

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

'如果計數器等于rngg區(qū)域的列數時，終止循環(huán)

If Col_count = Rngg.Columns.Count Then GoTo begin

End If

Next i

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

begin:

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

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

For Each Rng In Rngg '遍歷rngg區(qū)域(外層循環(huán))

For i = 1 To 5000

'如果cell區(qū)域的j +1 個單元格為顯示狀態(tài)，那么終止里層循環(huán)

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

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