VBA字典循环逻辑优化：实现每工作表仅插入2张图片

Great question—hardcoding those i > 4/i > 6 checks is messy and not scalable. Let's refactor this to use a clean, reusable logic that automatically creates new worksheets every 2 images, starting after the first 2 on the initial sheet.

Key Idea #

We'll track two simple metrics to avoid hardcoding:

• How many images we've added to the current worksheet
• Use integer division to detect when we hit the 2-image limit for a sheet (this works for any number of images, no magic numbers needed!)

Optimized Code #

Here's the revised loop with comments walking through each step:

Dim PictureFilename As Variant 
Dim FileList As Dictionary 
Dim i As Integer
Dim imagesOnCurrentSheet As Integer
Dim PicWorksheet As Worksheet

' Initialize counters and set starting worksheet
i = 0
imagesOnCurrentSheet = 0
Set PicWorksheet = PicWorkbook.ActiveSheet

For Each PictureFilename In FileList
    i = i + 1
    imagesOnCurrentSheet = imagesOnCurrentSheet + 1
    
    ' Check if we need a new sheet (triggers after 2 images per sheet)
    If imagesOnCurrentSheet > 2 Then
        ' Create new worksheet at the end of the workbook
        PicWorkbook.Sheets.Add(after:=PicWorkbook.Sheets(PicWorkbook.Sheets.Count)).Name = _
            "NewSheet " & Format(Now(), "mm-dd-yyyy") & " " & (i \ 2) ' Unique suffix to avoid duplicates
        ' Switch to the new worksheet
        Set PicWorksheet = PicWorkbook.Sheets(PicWorkbook.Sheets.Count)
        ' Reset counter for the new sheet
        imagesOnCurrentSheet = 1
    End If
    
    ' Add the picture to the current worksheet
    Set Photo = PicWorksheet.Shapes.AddPicture(CStr(PictureFilename), msoFalse, msoCTrue, 1, 1, -1, -1)
    colPictures.Add Photo
    Set Photo = Nothing ' Clean up object reference
Next

Breakdown of the Logic #

• imagesOnCurrentSheet: This counter keeps track of how many images are on the active sheet. When it exceeds 2, we spin up a new sheet and reset the counter to 1 (since we're about to add the first image to the new sheet).
• Unique Sheet Names: I added (i \ 2) as a suffix to ensure sheet names don't duplicate—this gives you "NewSheet... 1" for images 3-4, "NewSheet... 2" for 5-6, etc. Swap this out for your DefaultWorksheetNameAdder variable if needed.
• Scalability: This works for any number of images, whether you have 4, 10, or 100 entries in your dictionary. No more updating hardcoded checks as your image count grows.

Alternative Approach Using Integer Division #

If you prefer not to track a sheet-specific counter, you can use integer division to calculate which "group" the current image belongs to:

Dim PictureFilename As Variant 
Dim FileList As Dictionary 
Dim i As Integer
Dim currentGroup As Integer
Dim previousGroup As Integer
Dim PicWorksheet As Worksheet

i = 0
previousGroup = 0
Set PicWorksheet = PicWorkbook.ActiveSheet

For Each PictureFilename In FileList
    i = i + 1
    currentGroup = (i - 1) \ 2 ' Groups: 0 (images 1-2), 1 (3-4), 2 (5-6), etc.
    
    ' If we've moved to a new group, create a new sheet
    If currentGroup > previousGroup Then
        PicWorkbook.Sheets.Add(after:=PicWorkbook.Sheets(PicWorkbook.Sheets.Count)).Name = _
            "NewSheet " & Format(Now(), "mm-dd-yyyy") & " " & currentGroup
        Set PicWorksheet = PicWorkbook.Sheets(PicWorkbook.Sheets.Count)
        previousGroup = currentGroup
    End If
    
    ' Add the picture
    Set Photo = PicWorksheet.Shapes.AddPicture(CStr(PictureFilename), msoFalse, msoCTrue, 1, 1, -1, -1)
    colPictures.Add Photo
    Set Photo = Nothing
Next

This uses (i-1) \ 2 to bucket images into sets of 2. When currentGroup increases, we know it's time for a new sheet.

Either approach eliminates those messy hardcoded checks and works seamlessly for any size of your image dictionary.

内容的提问来源于stack exchange，提问作者ThisGuyJustNeedsHelp