Question

我正在尝试设置一个嵌套循环，只有当相关列有数据时才能将不同的列绑定在一起。

我所拥有的是这样一张桌子：

|Aname       |aterm    |amod     |
|            |         |         |
|Smith, Bob  |         |         |
|            |         |         |
|            |         |         |
|            | 2/6/2017|         |
|            |         |         |
|            |         |Module 1 |
|            |         |         |
|Smith, John |         |         |
|            |         |         |
|            |         |         |
|            |5/12/2017|         |
|            |         |Module 6 |
|            |         |         |
|            |         |Module 4 |
|            |         |         |
|            |6/12/2017|         |
|            |         |         |
|            |         |Module 10|
|            |         |Module 5 |

我想要做的是将列绑在一起，如下所示：

|aname       |aterm      |amod       |
|Smith, Bob  | 02/6/2017 | Module 1  |
|Smith, John | 5/12/2014 | Module 6  |
|Smith, John | 5/12/2014 | Module 4  |
|Smith, John | 6/12/2014 | Module 10 |
|Smith, John | 6/12/2014 | Module 5  |

下面是我放在一起的代码。不幸的是，印刷正在悄悄地进行数十次，间歇性地进行，并且根本不会出现这种情况。

Sub looper()

Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range

aname = ""
aterm = ""
amod = ""

Set listenroll = [table1[aname]]
Set atermrange = [table1[aterm]]
Set amodrange = [table1[amod]]

For Each rng In listenroll
    If IsEmpty(rng) = False Then
        Set aname = rng
        For Each rng2 In atermrange
            If IsEmpty(rng2) = False Then
                Set aterm = rng2
                For Each rng3 In amodrange
                    If IsEmpty(rng3) = False Then
                        Set amodrange = rng3
                        Range("I1").End(xlDown).Offset(1, 0) = aname
                        Range("J1").End(xlDown).Offset(1, 0) = aterm
                        Range("K1").End(xlDown).Offset(1, 0) = amod
                    End If
                Next rng3
            End If
        Next rng2
    End If
Next rng

有谁知道这里的问题是什么？

Answer 1

你只需要一个循环：

Sub looper()

    Dim aname As String
    'Dim aterm As String
    Dim aterm As Date
    Dim amod As String

    aname = ""
    'aterm = ""
    aterm = 0
    amod = ""

    Set listenroll = [table1[aname]]
    Set atermrange = [table1[aterm]]
    Set amodrange = [table1[amod]]

    Dim r As Long
    For r = 1 to amodrange.Rows.Count
        'Record value of AName whenever it changes
        If Trim(listenroll(r, 1).Value) <> vbNullString Then
            aname = Trim(listenroll(r, 1).Value)
        End If
        'Record value of ATerm whenever it changes
        If Trim(atermrange(r, 1).Value) <> vbNullString Then
            'aterm = Trim(atermrange(r, 1).Value)
            aterm = CDate(atermrange(r, 1).Value)
        End If
        'Write output each time there is something in amod
        If Trim(amodrange(r, 1).Value) <> vbNullString Then
            amod = Trim(amodrange(r, 1).Value)
            Range("I1").End(xlDown).Offset(1, 0) = aname
            Range("J1").End(xlDown).Offset(1, 0) = aterm
            Range("K1").End(xlDown).Offset(1, 0) = amod
        End If
    Next

注意：我不确定如何修改aterm以匹配您的问题的示例，但我希望这只是示例中的拼写错误。

而且，FWIW，您在现有代码中遇到一个主要错误：Set amodrange = rng3。我不确定这是否是唯一错误。

Answer 2

我有替代解决方案。这与YowE3K的代码基本相同，但是还有一个for循环和一个if语句。这是因为，假设您的表存在，我使用了列A B C而不是使用表名，而是将值存储在数组中。

试试这个：

Sub looper()
Dim i As Long, j As Long, LastCell As Long
Dim arr() As String
ReDim arr(2)
With Sheets("Sheet1")
    LastCell = .UsedRange.Rows.Count
    For i = 2 To LastCell
        For j = 1 To 3
            If Not IsEmpty(.Cells(i, j)) Then
                arr(j - 1) = .Cells(i, j)
                If j = 3 Then
                    .Cells(.Rows.Count, "I").End(xlUp).Offset(1, 0) = arr(0)
                    .Cells(.Rows.Count, "J").End(xlUp).Offset(1, 0) = arr(1)
                    .Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0) = arr(2)
                End If
            End If
        Next j
    Next i
End With
End Sub

Excel VBA - 三重嵌套循环将列键绑定在一起

2 个答案: