时间戳

首页 > 解决方案 > 在命名范围内选择使用的行？

excel - 在命名范围内选择使用的行？

问题描述

我有一个名为 Range 的 Excel Schd_Preview，它由 cells 组成F3:K500。有时只使用 2 或 3 行，有时使用 200 行，有时使用所有行。如何Schd_Preview在 VBA 中仅复制使用的行？

Schd_Preview编辑：我在 B2:C12 范围内 的左侧有数据。Intersect()将不起作用，.UsedRange因为即使命名范围仅使用 2 行，它也至少包含第 12 行。

标签： excelvba

解决方案

范围内使用的行

  • NonCont并Cont参考使用的行，即它们是否连续。
  • 如果您隐藏了已使用的行，第一个解决方案将不起作用。

编码

Option Explicit

Sub NonCont1() ' Values, formulas, formats.
    Const PasteCell As String = "M3"
    With Range(PasteCell)
       .Resize(.Worksheet.Rows.Count - .Row + 1, _
               Range("Schd_Preview").Columns.Count).Clear
    End With
    Dim rng As Range ' Copy Range
    Set rng = Range("Schd_Preview").SpecialCells(xlCellTypeVisible)
    rng.Copy Range(PasteCell) ' If you need values, then use 'PasteSpecial'.
'    rng.Copy
'    Range(PasteCell).PasteSpecial xlPasteValues
'    Application.CutCopyMode = False
End Sub

Sub NonCont2() ' Values only.
    Const PasteCell As String = "M3"
    Const LastRowCol As Long = 1 ' in your case 1-6 (F-K).
    Dim Data As Variant
    Data = Range("Schd_Preview").Value
    Dim UB2 As Long
    UB2 = UBound(Data, 2)
    Dim i As Long
    Dim j As Long
    Dim k As Long
    For i = 1 To UBound(Data, 1)
        If Data(i, LastRowCol) <> "" Then
            k = k + 1
            For j = 1 To UB2
                Data(k, j) = Data(i, j)
            Next j
        End If
    Next i
    With Range(PasteCell)
       .Resize(.Worksheet.Rows.Count - .Row + 1, UB2).Clear
       Dim rng As Range ' Paste Range
       Set rng = .Resize(k, UB2)
    End With
    rng.Value = Data
End Sub

' Surrounded by empty rows and columns.
Sub cont1()
    Const PasteCell As String = "M3"
    With Range(PasteCell)
       .Resize(.Worksheet.Rows.Count - .Row + 1, _
               Range("Schd_Preview").Columns.Count).Clear
    End With
    Dim rng As Range ' Copy Range
    Set rng = Range("Schd_Preview").Cells(1).CurrentRegion
    rng.Copy Range(PasteCell) ' Values, formulas, formats.
    'Range(PasteCell).Resize(rng.Rows.Count, rng.Columns.Count).Value _
      = rng.Value ' Values only.
End Sub

' Empty column to the right, and empty row at the bottom.
Sub cont2()
    Const PasteCell As String = "M3"
    With Range(PasteCell)
       .Resize(.Worksheet.Rows.Count - .Row + 1, _
               Range("Schd_Preview").Columns.Count).Clear
    End With
    Dim cel As Range
    Set cel = Range("Schd_Preview").Cells(1)
    Dim rng As Range ' Copy Range
    Set rng = Range("Schd_Preview").Cells(1).CurrentRegion
    With rng
        Set rng = .Resize(.Rows.Count + .Row - cel.Row, _
                          .Columns.Count + .Column - cel.Column) _
                  .Offset(cel.Row - .Row, cel.Column - .Column)
    End With
    rng.Copy Range(PasteCell) ' Values, formulas, formats.
    'Range(PasteCell).Resize(rng.Rows.Count, rng.Columns.Count).Value _
      = rng.Value ' Values only.
End Sub

Sub cont3() ' Values only. It's a simplified 'NonCont2'.
    Const PasteCell As String = "M3"
    Const LastRowCol As Long = 1 ' in your case 1-6 (F-K).
    Dim Data As Variant
    Data = Range("Schd_Preview").Value
    Dim UB2 As Long
    UB2 = UBound(Data, 2)
    Dim i As Long
    For i = 1 To UBound(Data, 1)
        If Data(i, LastRowCol) = "" Then
            Exit For
        End If
    Next i
    With Range(PasteCell)
       .Resize(.Worksheet.Rows.Count - .Row + 1, UB2).Clear
       Dim rng As Range ' Paste Range
       Set rng = .Resize(i - 1, UB2)
    End With
    rng.Value = Data
End Sub

推荐阅读