递增字母数字条件的数字部分，以搜索多列并使用Excel VBA打印记录

我应该注意到，我的问题在网上有相关的解决方案，但我无法将它们应用到我自己的情况中

我们有一个.mdb数据库，包含我们生产的所有产品。我已经设法采用了两个标准（订单类型和方框），并将包含这两个标准的所有记录打印到Excel中。除此之外，我现在还需要一次性打印30个框，作为更大模板的基础。这些框的标签通常是递增的（例如P1、P2…P30），我很难看到如何递增它的数字部分以使其适合我的代码。理想情况下，我希望用户在excel中输入第一个和最后一个框编号，以表示整个范围（P1和P30），并使用这两个值

Sub Dan()
    Dim order As String
    Dim title As String        'initialize title
    Dim palette As String      'intialize comment
    Dim finalpalette As String
    Dim finalrow As Integer    'initialize bottom-most row
    Dim i As Integer
    Dim Cntr As Integer
    Dim LR As Integer

    'Clears the contents of the last macro run
    With Sheets("ALL.txt")
       .Range(.Cells(6, 2), .Cells(725, 8)).ClearContents 'equates to (D2:F26)/          row, column ;Erase Columns for next macro
    End With

    title = Sheets("Sheet2").Range("B1").Value
    palette = Sheets("Sheet2").Range("B2").Value
    finalrow = Sheets("Sheet1").Range("A2").End(xlDown).Row

    For i = 3 To finalrow
        If Cells(i, 1) = title And Cells(i, 2) = palette Then
            Cells(i, 5).Copy 'Copy ID
            Sheets("ALL.txt").Range("B734").End(xlUp).Offset(1, 0).PasteSpecial

            Range(Cells(i, 11), Cells(i, 14)).Copy
            Sheets("ALL.txt").Range("C734").End(xlUp).Offset(1, 0).PasteSpecial

            Range(Cells(i, 9), Cells(i, 10)).Copy
            Sheets("ALL.txt").Range("G734").End(xlUp).Offset(1, 0).PasteSpecial        
        End If
    Next i

End Sub

我想要调整的变量是“调色板”。我最初使用它将记录匹配到一个框（P1）。我需要的是能够匹配循环中30个框（P1到P30）的记录。变量“palette”只是获取当前单元格B2中任何内容的静态值。我认为应该有某种方法将第一个和最后一个框键入两个单元格，以建立宏迭代的范围，或者将所有框编号写入一列，并让“调色板”在每个循环中向下移动一个单元格，以获取新的框值

为了从将所有30个框写入30个单元格的列中获取数据，我尝试了以下代码行

        End If
palette = Sheets("Sheet2").Range("B2").Offset(, 1)
Next i

---

但它似乎没有抓住任何价值。它应该从单元格B2到B31获取值。

这里是我更改的一些代码（仍然不知道为什么要将其分为3个部分，似乎excel VBA是使其复杂化的额外步骤）

此工作簿。工作表（1）。单元格（i，5）

在学习VBA时使用完整参考资料

让我知道如果这样做有效，我对你的情况了解得不够，除了我能看到你在努力做什么之外，我不知道你到底需要什么

Sub Dan()

Dim Order As String
Dim Title As String        'initialize title
Dim Palette As String      'intialize comment
Dim Fpalette As String
Dim Frow As Integer    'initialize bottom-most row
Dim i As Integer
Dim Cntr As Integer
Dim LR As Integer
Dim wsALL As Worksheet

'Clears the contents of the last macro run
With Sheets("ALL.txt")
    .Range(.Cells(6, 2), .Cells(725, 8)).ClearContents 'equates to (D2:F26)/         row, column ;Erase Columns for next macro
End With

Title = Sheets("Sheet2").Range("B1").Value
Palette = Sheets("Sheet2").Range("B2").Value
Frow = Sheets("Sheet1").Range("A2").End(xlDown).Row

Set wsALL = Sheets("ALL.txt")

    i = 2

    Do While i < Frow

        i = i + 1

        If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1) = Title And ThisWorkbook.Worksheets("Sheet1").Cells(i, 2) = Palette Then

            Sheets("Sheet1").Cells(i, 5).Copy Destination:=wsALL.Range("B734").End(xlUp).Offset(1, 0)
            'wsALL.Range("B734").End(xlUp).Offset(1, 0).PasteSpecial

            Sheets("Sheet1").Range(Cells(i, 11), Cells(i, 14)).Copy Destination:=wsALL.Range("C734").End(xlUp).Offset(1, 0)
            'wsALL.Range("C734").End(xlUp).Offset(1, 0).PasteSpecial

            Sheets("Sheet1").Range(Cells(i, 9), Cells(i, 10)).Copy Destination:=wsALL.Range("G734").End(xlUp).Offset(1, 0)
           'wsALL.Range("G734").End(xlUp).Offset(1, 0).PasteSpecial

        End If

    Loop

End Sub

为防止空间出现任何问题，可通过以下方式进行：

set pStart = Trim(ActiveCell(2,1).Value)

或者另一种方法是使用数据验证并为用户提供下拉列表

---

---

下面是两种方法的代码。请注意，我做了一些编辑，大多数都不是必要的更改，只是如何编写VBA。当您使用copy->paste命令时，如果您说

。copy Destination:=

另一条注释，它将避免剪贴板，这在Access中非常容易，只需编写一条SQL语句并使用append功能。你说在这之前有一个宏，在这之后，我会说让它成为一个（非常强大和漂亮的）SQL语句，通过用户表单运行。

感谢Nathan的输入。我将在原始帖子中重新表述我的问题。

set pStart = Trim(ActiveCell(2,1).Value)