通过VBA在Excel中调整命名区域的大小

我有一个命名范围，我需要根据命名的范围内有多less个值来resize。 例如，如果有十个项目的范围应该是$ A $ 1：$ I11，但我需要它缩小以及扩大。 这是我到目前为止：

Sub Generate() Dim wsFail as Worksheet Dim NextRow As Long, TotalRows As Long Set wsFail = Sheets("Failure Report") wsFail.Activate NextRow = Sheets("Failure Report").Range("A" & Rows.Count).End(xlUp).Row TotalRows = Range("FailReportTable").Rows.Count Sheets("Failure Report").Range("A" & TotalRows).Resize(TotalRows, 9).Value & _ = Range("FailReportTable").Columns("A:I").Value End Sub 

更新的代码（仍然不工作）

 With wsFail .Activate NextRow = .Cells(.Rows.Count, .Range("FailReportTable").Cells(1, 1).Column).End(xlUp).Row FirstCell = .Range("FailReportTable").Cells(1, 1).Address(False, False) LastCol = Split(.Range("FailReportTable").Cells(1, Range("FailReportTable").Columns.Count).Address(True, False), "$")(0) NewRange = FirstCell & ":" & LastCol & NextRow .ListObjects("FailReportTable").Resize Range("NewRange") End With 

Answer 1

最终版本调整命名范围（带或不带标头）

1. 将FailReportTable更改为您的NamedRange的名称
2. 将Failure Report更改为您的NamedRange的工作表名称

代码：

 Sub test_Gerasimos_Zap() Dim wsFail As Worksheet, _ FirstCell As String, _ LastCol As String, _ NextRow As Long, _ NewRange As String Set wsFail = Sheets("Failure Report") With wsFail .Activate NextRow = .Cells(.Range("FailReportTable").Cells(1, 1).Row, .Range("FailReportTable").Cells(1, 1).Column).End(xlDown).Row FirstCell = .Range("FailReportTable").Cells(1, 1).Offset(-1, 0).Address(False, False) LastCol = Split(.Range("FailReportTable").Cells(1, .Range("FailReportTable").Columns.Count).Address(True, False), "$")(0) NewRange = FirstCell & ":" & LastCol & NextRow .ListObjects("FailReportTable").Resize Range(NewRange) End With End Sub 

Answer 2

这是你想要的吗？ 这里MyRange定义为$B$5$:$B$5$ ，代码将其扩展为所有被占用的单元格为$B$5:$E$11 。

 Public Sub Test() Dim N As Long, M As Long, r As Range Set r = Worksheets("Sheet1").Range("MyRange") N = CountRows(r) M = CountCols(r) Debug.Print r.Resize(N, M).AddressLocal ' $B$5:$E$11 End Sub Public Function CountCols(ByVal r As Range) As Long If IsEmpty(r) Then CountCols = 0 ElseIf IsEmpty(r.Offset(0, 1)) Then CountCols = 1 Else CountCols = r.Worksheet.Range(r, r.End(xlToRight)).Columns.Count End If End Function Public Function CountRows(ByVal r As Range) As Long If IsEmpty(r) Then CountRows = 0 ElseIf IsEmpty(r.Offset(1, 0)) Then CountRows = 1 Else CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count End If End Function