嵌套循環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設置為某種值（並非所有列都為空白）。