循环通过不同大小的表Excel VBA

时间:2016-02-05 05:27:23

标签: excel vba excel-vba

之前的问题得到了解答,为我提供了这个循环的基础。

VBA Excel - Loop through worksheet creating tables

但是,我遇到了一个问题,我可能会在其下面的行中有一个没有数据的表头。在这种情况下,我只想创建一个只有标题的表。

我尝试过这段代码 - 只需将rngStart下面的行指定为oneDown即可。然后创建一个if / then来检查len(oneDown)是否> 0

{{1}}

我的数据得到了相同的结果,就好像我没有if / then一样。

1 个答案:

答案 0 :(得分:1)

我不得不改变你的部分代码,但是我可以测试它,所以试一试:

  Dim ws As Worksheet
    Set ws = ActiveSheet

    With ws

    'find last row of data in column A
    Dim lRow As Long
    lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Dim rngStart As Range
    Set rngStart = .Range("A3")

    'set counter variable for naming tables
    Dim i As Long
    i = i + 1

    Do

Dim oneDown As String
 oneDown = rngStart.Offset(1)

'Proceed to next cell if rngstart is empty
If rngStart.Value = "" Then
   Set rngStart = rngStart.Offset(1)
ElseIf Len(oneDown) > 0 Then
    'create table range
    Set rngtable = .Range(rngStart.End(xlToRight), rngStart.End(xlDown))
    'create table
    .ListObjects.Add(xlSrcRange, rngtable.Resize(rngtable.Rows.Count, rngStart.End(xlToRight).Column), , xlYes).Name = "Table" & i
    'set style
    .ListObjects("Table" & i).TableStyle = "TableStyleLight9"
    'find next table range start
    Set rngStart = rngtable.End(xlDown).Offset(1)
     i = i + 1
 Else
'create table range
    Set rngtable = .Range(rngStart.End(xlToRight), rngStart)
    'create table
    .ListObjects.Add(xlSrcRange, rngtable.Resize(rngtable.Rows.Count, rngStart.End(xlToRight).Column), , xlYes).Name = "Table" & i
    .ListObjects("Table" & i).TableStyle = "TableStyleLight9"
    Set rngStart = rngtable.End(xlDown).Offset(1)
     i = i + 1
End If


    Loop Until rngStart.Row > lRow

    End With