我有一个文件,希望宏在其中找到特定的标头,然后选择该特定列中的所有数据。此列之间有空白行。例如,我要选择产品栏(请参见屏幕截图)。
这里的挑战是我不能使用rows.count代码,因为列可能会不时更改,并且我不能使用任何特定的单元格范围来编写代码。
我也不能选择整个列,因为我需要从两个不同的选项卡中复制产品并将其粘贴到一个文件中。
有没有一种方法可以使用活动单元格编写代码并从上到下选择范围?
Sheets("PB").Select
Cells.Find(What:="product").Select
ActiveCell.Offset(1, 0).Select
答案 0 :(得分:0)
好吧,您可以获得填充的最后一行的行号(无论是否更改,每次运行sub都将获得该列的最后一行)。
lastRow = worksheets("PB").cells(rows.count,7).end(xlup).row
然后您可以将范围设置为:
set myRange = worksheets("PB").range("B1:B" & lastRow )
答案 1 :(得分:0)
您的代码是一个很好的开始,并且您已经说过,您只需要以可靠的方式选择行数即可。
获得我们将要挖掘的空白范围:
Set rngTopCell = Range(ActiveCell.Offset(1, 0)
Set rngBottomCell = ActiveCell.Offset(ActiveCell.CurrentRegion.Rows.Count, 0)
Set rngProductColumn = Range(rngTopCell, rngBottomCell)
然后获得该范围内的空白:
Set rngProductBlanks = rngProductColumn.SpecialCells(xlCellTypeBlanks)
这种方法避免了对特定列的依赖。
答案 2 :(得分:0)
除非您知道已找到该单元格,否则请不要尝试选择它。
此代码将在第1行中搜索标题,然后选择其下方的数据(将Rows(1)
更改为Cells
以搜索整个工作表)。
Sub Test()
Dim MyData As Range
'Ask the function to return the column headed "product"
Set MyData = Return_Data("product")
If MyData Is Nothing Then
MsgBox "Column is empty."
Else
MsgBox MyData.Address
MyData.Select
End If
End Sub
Public Function Return_Data(Heading As String) As Range
Dim rCol As Range
'Dim rDataRange As Range
Dim rLastCell As Range
With ThisWorkbook.Worksheets("PB")
'Look for the column header.
Set rCol = ThisWorkbook.Worksheets("PB").Cells.Find( _
What:=Heading, After:=.Cells.Cells(1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rCol Is Nothing Then
'Set rLastCell = .Cells(.Rows.Count, rCol.Column).End(xlUp) 'Find last row in "product" column.
Set rLastCell = .Cells(.Rows.Count, 6).End(xlUp) 'Find last row in column 6 (F).
If rLastCell.Row >= 2 Then
'If the last cell is below the header than the column had data.
'Set reference to one cell below the header down to the last cell.
'Set Return_Data = .Range(rCol.Offset(1), rLastCell) 'If using last row in "product" column.
Set Return_Data = .Range(rCol.Offset(1), .Cells(rLastCell.Row, rCol.Column)) 'If using last row in column 6.
Else
'Otherwise it's an empty column.
Set Return_Data = Nothing
End If
End If
End With
End Function
我添加了代码以在“产品”列中找到最后一行,或者在最后一行中使用“部门”列。
答案 3 :(得分:0)
Option Explicit
Sub ColumnWithBlanks()
Const cVntWsName As Variant = "PB" ' Worksheet Name or Index ("PB" or 1)
Const cLngHeaderRow As String = 1 ' Header Row
Const cStrLast As String = "Dept" ' Last Row Column Header
Const cStrSource As String = "Product" ' Source Column Header
Dim rngLast As Range ' Last Row Column (Range)
Dim rngSource As Range ' Source Column, Source Range
With ThisWorkbook.Sheets(cVntWsName)
' Find first (header) cell in Last Row Column
Set rngLast = .Rows(cLngHeaderRow).Find(What:=cStrLast, _
After:=.Cells(cLngHeaderRow, Columns.Count), LookIn:=xlFormulas, _
Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
' Find first (header) cell in Source Column
Set rngSource = .Rows(cLngHeaderRow).Find(What:=cStrSource, _
After:=.Cells(.Rows(cLngHeaderRow), Columns.Count), _
LookIn:=xlFormulas, Lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
' Find last non-empty cell in Last Row Column
Set rngLast = rngLast.Resize(Rows.Count - rngLast.Row + 1, 1) _
.Find(What:="*", After:=rngLast.Cells(1, 1), LookIn:=xlFormulas, _
Lookat:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious) _
.Offset(0, rngSource.Column - rngLast.Column)
' Calculate Source Range
Set rngSource = .Range(rngSource.Offset(1, 0), rngLast)
Set rngLast = Nothing
End With
Debug.Print rngSource.Address
' To refer to this worksheet you can use "rngSource.Parent" e.g.:
Debug.Print rngSource.Parent.Name
' To refer to this workbook you can use "rngSource.Parent.Parent" e.g.:
Debug.Print rngSource.Parent.Parent.Name
' To refer to another worksheet in this workbook you can use e.g.
' "rngSource.Parent.Parent.Worksheets("Sheet2")"
Debug.Print rngSource.Parent.Parent.Worksheets("Sheet2").Name
' To copy the range to another range in this worksheet e.g.:
' rngSource.Copy rngSource.Parent.Range("A1")
Set rngSource = Nothing
End Sub