Question

这是我在这里发表的第一篇文章，以便您提前获得帮助。多么棒的社区！

我正在尝试编写一个宏，它将遍历未确定行数和一个一个副本的值列表并将值粘贴到单个单元格中，每次循环替换刚刚粘贴到的值单个单元格，由报告模板引用，并根据数字的ID

自动填充数据

以下是表格的示例：

__|__A__|__B__
1 | 231 | 234
2 | 232 |
3 | 233 |
4 | 234 |
5 | 235 |
6 | 236 |

231将被复制并粘贴到B1中，然后232将被复制并粘贴到B1中，然后233将被复制并粘贴到B1中，然后234将被复制并粘贴到B1 .....依此类推等等。在复制和过去的步骤之间，还有其他步骤将图像添加到工作表并另存为pdf。

我写了这个脚本来实现目标：

Sub Report()
'
' Report Macro
'
' Keyboard Shortcut: Ctrl+Shift+G
'
' this section just copies a selection of cells from on worksheet and moves it to another worksheet filters it and copies filtered list to yet another worksheet.
Application.ScreenUpdating = False
Selection.Copy
Sheets("Master Sheet").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$A$5:$BS$410").AutoFilter Field:=7, Criteria1:="2"
Selection.Copy
Sheets("Report").Select
Range("A1").Select
ActiveSheet.Paste
' This section does the operation outlined at beginning of post.
Range("A1").Select
Do Until IsEmpty(ActiveCell.Value)
    Selection.Copy
    Range("B1").Select
    ActiveSheet.Paste
    Application.Run "PERSONAL.XLSB!ErasePhoto"
    Application.Run "PERSONAL.XLSB!PhotoPlace"
    ActiveWindow.ScrollRow = 1
    Application.CutCopyMode = False
    ChDir "C:"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("B3").Value          _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True,  IgnorePrintAreas _
    :=False, OpenAfterPublish:=True
    Application.Run "PERSONAL.XLSB!ErasePhoto"
    ActiveCell.Offset(1, 0).Select
Loop
End Sub

当我运行宏时，它会成功通过，但不会循环。我不知道为什么？感谢!!!!

Answer 1

在执行循环时，逐步执行代码以查看哪些单元格是活动单元格？代码将B1设置为每个循环中的活动单元。在不知道被调用的程序做什么的情况下，很难在循环之前判断哪个单元格受ActiveCell.Offset(1, 0).Select影响。

代码有很多不必要的选择和激活语句。清理它。

Answer 2

好的，所以我能够在一个excel论坛上找到一个名叫skywriter的非常善良的人。它就像一个魅力。

Dim r As Range 
For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp)) 
    Range("B1").Value = r.Value 
    Application.Run "PERSONAL.XLSB!ErasePhoto" 
    Application.Run "PERSONAL.XLSB!PhotoPlace" 
    ActiveWindow.ScrollRow = 1 
    Application.CutCopyMode = False 
    ChDir "C:" 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF,       Filename:=Range("B3").Value _ 
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ 
    :=False, OpenAfterPublish:=True 
    Application.Run "PERSONAL.XLSB!ErasePhoto" 
Next r

Answer 3

我通过添加counter变量对您的代码进行了细微更改，然后在Do Until循环中使用该变量。这使您可以使用Offset选择所需的单元格。

' This section does the operation outlined at beginning of post.
Range("A1").Select
Dim counter As Long    '---->line added
counter = 1            '---->line added
Do Until IsEmpty(ActiveCell.Value)
    Selection.Copy
    Range("B1").Select
    ActiveSheet.Paste
    Application.Run "PERSONAL.XLSB!ErasePhoto"
    Application.Run "PERSONAL.XLSB!PhotoPlace"
    ActiveWindow.ScrollRow = 1
    Application.CutCopyMode = False
    ChDir "C:"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("B3").Value _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=True
    Application.Run "PERSONAL.XLSB!ErasePhoto"
    ActiveCell.Offset(counter, -1).Select    '----> make change here
    counter = counter + 1                    '----> line added
Loop

Macro Do Until循环复制从值列表粘贴到单个单元格（例如b1）

3 个答案: