嵌套循环 Excel VBA

Question

在下一个 VBA 循环中我需要您的帮助。我在两列中有一些数据，行之间有空白行。这个宏循环遍历一列并找出它是否包含某个字符。如果它是空白的，那么我希望它移动到下一行。如果它包含“Den”，则选择一个特定的工作表（“D-Temp”），否则选择（“M-Temp”）。 选择正确的工作表后，需要根据行号用第二列的数据填充文本框。到目前为止我创建的代码是

Sub Template()

    Dim j As Long
    Dim c As Range, t As Range
    Dim ws As String

    j = 5
    With Sheets("Sample ")
        For Each c In .Range("I3", .Cells(.Rows.Count, "I").End(xlUp))
            If c.Value = "" Then
                Next ' `Not getting how to jump to next one`
            ElseIf c.Value = "DEN" Then
                ws = "D-Temp"
            Else
                ws = "M-Temp"
            End If

        For Each t In .Range("P3", .Cells(.Rows.Count, "P").End(xlUp))
            If t.Value <> "" Then
                j = j + 1
                Sheets("M-Temp").Copy after:=Sheets(Sheets.Count)
                ActiveSheet.Shapes("Textbox 1").TextFrame.Characters.Text = t.Value
                ActiveSheet.Shapes("textbox 2").TextFrame.Characters.Text = t.Offset(, -1).Value
            End If
        Next
    Next
    End With

有什么帮助吗？？ 以下是我拥有的示例数据：

Type    Name 1  Name2
DEN     Suyi    Nick
                     'Blank row'
PX      Mac     Cruise

我希望宏识别类型并根据该选择模板工作表（D 或 M），并分别用名称 1 和名称 2 填充该模板上的文本框。

Answer 1

可能是你追求这个：

Option Explicit

Sub Template()
    Dim c As Range

    With Sheets("Sample")
        For Each c In .Range("I3", .Cells(.Rows.Count, "I").End(xlUp)).SpecialCells(xlCellTypeConstants) ' loop through referenced sheet column C not empty cells form row 3 down to last not empty one
            Worksheets(IIf(c.Value = "DEN", "D-Temp", "M-Temp")).Copy after:=Sheets(Sheets.Count) ' create copy of proper template: it'll be the currently "active" sheet
            With ActiveSheet ' reference currently "active" sheet
                .Shapes("Textbox 1").TextFrame.Characters.Text = c.Offset(, 7).Value ' fill referenced sheet "TextBox 1" shape text with current cell (i.e. 'c') offset 7 columns (i.e. column "P") value
                .Shapes("Textbox 2").TextFrame.Characters.Text = c.Offset(, 6).Value ' fill referenced sheet "TextBox 2" shape text with current cell (i.e. 'c') offset 6 columns (i.e. column "O") value
            End With
        Next
    End With
End Sub

Answer 2

如果我没有误解您当前的嵌套...

With Sheets("Sample ")
    For Each c In .Range("I3", .Cells(.Rows.Count, "I").End(xlUp))

        If c.Value <> "" Then
            If c.Value = "DEN" Then
                ws = "D-Temp"
            Else
                ws = "M-Temp"
            End If
            For Each t In .Range("P3", .Cells(.Rows.Count, "P").End(xlUp))
                If t.Value <> "" Then
                    j = j + 1
                    Sheets("M-Temp").Copy after:=Sheets(Sheets.Count)
                    ActiveSheet.Shapes("Textbox 1").TextFrame.Characters.Text = t.Value
                    ActiveSheet.Shapes("textbox 2").TextFrame.Characters.Text = t.Offset(, -1).Value
                End If
            Next
        End if 'not blank
    Next
End With

Answer 3

如果我正确理解了您的问题，您需要稍微更改您的 if/then 逻辑：

Sub Template()

    Dim j As Long
    Dim c As Range, t As Range
    Dim ws As String

    j = 5
    With Sheets("Sample ")
        For Each c In .Range("I3", .Cells(.Rows.Count, "I").End(xlUp))
            If c.Value <> "" Then
                If c.Value = "DEN" Then
                    ws = "D-Temp"
                    Exit For
                Else
                    ws = "M-Temp"
                    Exit For
                End If
            End If
        Next
        For Each t In .Range("P3", .Cells(.Rows.Count, "P").End(xlUp))
            If t.Value <> "" Then
                j = j + 1
                Sheets("M-Temp").Copy after:=Sheets(Sheets.Count)
                ActiveSheet.Shapes("Textbox 1").TextFrame.Characters.Text = t.Value
                ActiveSheet.Shapes("textbox 2").TextFrame.Characters.Text = t.Offset(, -1).Value
            End If
        Next
    End With
End Sub

您可能需要添加代码以确保将 ws 设置为某个值（并非所有列都是空白的）。