如何改善“当前区域”选择器?

时间:2019-06-24 13:40:52

标签: excel vba

我已经为热键分配了一个简单的宏,以选择当前区域,然后删除标题行。问题在于,我们使用的范围通常充满空白单元格,从而阻止了选择器根据活动单元格捕获整个表。

我考虑过可能只是创建一个循环,使ActiveCell偏移并重试直到其到达非法范围,但是我对此方法有不好的感觉。

Sub multieditSelect()
Dim tbl As Range
If ActiveCell.Value = "" Then
    MsgBox "Select a cell with something in it, you bastard"
    Exit Sub
End If
Call startNoUpdates
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
tbl.Columns.Count).Select
Call endNoUpdates
Selection.Copy
End Sub

有没有办法使它更可靠?

编辑:让我为这个问题添加更多的复杂性/细节...

我们需要处理数据库并编辑记录,这需要将它们导出到excel,然后将它们复制/粘贴回Web界面,因此使用工作表处理大量不同大小的表是很常见的。就像记事本来存储和修改它们。

我想创建一个子控件,无论其在工作表上的位置如何,都将选择当前区域,很可能这是已粘贴到同一工作表上的第三或第四张表。

这使得转到最后一列或最后一行太不灵活。 CurrentRegion是理想的,如果不是因为偶尔无法检测到表而导致......所以我想我需要构建自己的CurrentRegion版本来克服它的缺点。

Edit2:我提出了一个懒惰的解决方案。 由于这些表将始终具有标题,因此我将仅使activecell偏移直到它碰到某些东西为止,希望如果以空列为起点,则将其作为标题。

我认为,如果桌子中间有一个被空单元包围的单元格,这仍然是不可靠的。

Sub multieditSelect2()
Dim tbl As Range
On Error GoTo errmsg
startNoUpdates
Do While ActiveCell.Value = ""
    ActiveCell.Offset(-1, 0).Activate
Loop
startNoUpdates
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
tbl.Columns.Count).Select
endNoUpdates
Selection.Copy
Exit Sub

errmsg:
endNoUpdates
errMsgBox = MsgBox("Couldn't find a table!", vbCritical, "Error!")
End Sub

Edit3:这是我的代码调用示例:

Example Table

我希望它即使在测试区域中的单元格为活动单元格的情况下也能够捕获表...但是如何?

1 个答案:

答案 0 :(得分:0)

除了我的评论外,请查看这是否有助于改善您的逻辑(有关更多详细信息,请参见代码中的评论):

Sub multieditSelect()

Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1") 'use a variable for the sheet you want to use

Dim tbl As Range
Dim lRow As Long, lCol As Long

lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row 'last row at column 1
lCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column 'last column at row 1

Set tbl = ws.Range(ws.Cells(2, l), ws.Cells(lRow, lCol)) 'Set the range starting at row 2, column 1, until last row, last col

Call endNoUpdates(tbl) 'pass your range as a parameter if you require this specific range in your other sub

tbl.Copy Destination:=tbl.Offset(0, 20)  'copy 20 columns to the right

'Alternative
ws.Range("W1").Resize(tbl.Rows.Count, tbl.Columns.Count).Value = tbl.Value 'copy values to specific range

End Sub

Sub endNoUpdates(tbl As Range)

    'do something with this range, i.e.:
    Debug.Print tbl.address

End Sub