VBA回圈遍歷陣列

我遇到了以下問題：作業簿包含一個名為“名稱”的作業表。它包含姓名和姓氏、英文姓名、俄羅斯姓名以及員工性別和代碼的列。該代碼應該從列中獲取值，然后它創建一個陣列并遍歷這些陣列，它應該相應地更改另一張表上的值，例如員工 1、員工 1 的姓名、...員工 1 的代碼, 員工 2, 員工 2 的姓名, ... 員工 2 的代碼 但它以以下方式進行: 員工 1, 員工 1 的姓名, ... 員工 1 的代碼, 員工 1, 員工 1 的姓名, ... . 員工 2 的代碼、員工 1 的代碼、員工 1 的姓名、......員工 3 的代碼等等。很明顯，我丟失了應該以某種方式實作的代碼，但我找不到它。

代碼如下。非常感謝您提前！

Sub SaveAsPDF()

Dim ws As Workbook
Dim nm As Worksheet
Dim last_row As Long
Dim names_surname, name, sex, promocode As Variant
Dim Certificate As Worksheet
Dim FilePath As String

Set ws = ThisWorkbook
Set nm = ws.Sheets("Names")

With nm
    last_row = .Range("A1").CurrentRegion.Rows.Count
    names_surname = Application.Transpose(nm.Range("E2:E" & last_row).Value2)
    name = Application.Transpose(.Range("F2:F" & last_row).Value2)
    sex = Application.Transpose(.Range("G2:G" & last_row).Value2)
    promocode = Application.Transpose(.Range("H2:H" & last_row).Value2)
End With

Set Certificate = ws.Sheets("Certificate_PDF")
FilePath = "C:\Users\name\folder\2021\Desktop\Certificates"

For Each ns In names_surname
    For Each n In name
        For Each s In sex
            For Each p In promocode
                If s = "mr" Then
                    Certificate.Range("Name").Value = "Dear, " & n & "!"
                Else
                    Certificate.Range("Name").Value = "Dear, " & n & "!"
                End If
                    Certificate.Range("Promo").Value = "Code: " & p
                    Certificate.PageSetup.Orientation = xlPortrait
                    Certificate.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FilePath & "\" & ns & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False

                Next p
            Next s
        Next n
    Next ns

MsgBox "Completed", vbInformation

End Sub

uj5u.com熱心網友回復：

不要嵌套回圈，只需回圈遍歷一個二維陣列。

Option Explicit
Sub SaveAsPDF()

    Dim wb As Workbook
    Dim wsNm As Worksheet, wsCert As Worksheet
    Dim last_row As Long
    Dim ar As Variant
    Dim FilePath As String
    
    Set wb = ThisWorkbook
    Set wsNm = wb.Sheets("Names")
    With wsNm
        last_row = .Cells(.Rows.Count, "E").End(xlUp).Row
        ar = .Range("E2:H" & last_row).Value2
    End With
    
    Set wsCert = wb.Sheets("Certificate_PDF")
    FilePath = wb.Path '"C:\Users\name\folder\2021\Desktop\Certificates"
    
    Dim i As Long, fullname As String, name As String, sex As String, promocode As String
    For i = 1 To UBound(ar)
        fullname = ar(i, 1) ' E name surname
        name = ar(i, 2) ' F
        sex = ar(i, 3) ' G
        promocode = ar(i, 4) 'H
        
        With wsCert
            If sex = "mr" Then
                .Range("Name").Value = "Dear, " & name & "!"
            Else
                .Range("Name").Value = "Dear, " & name & "!"
            End If
            .Range("Promo").Value = "Code: " & promocode
            
            ' export as pdf
            .PageSetup.Orientation = xlPortrait
            .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=FilePath & "\" & fullname & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False
       End With
    Next
    
    MsgBox UBound(ar) & " pdfs generated", vbInformation
End Sub

標籤：数组 擅长 vba

上一篇：將范圍復制到具有相同格式的作業表

下一篇：滿足條件時著色行