创建 VBA 以过滤数据库并根据项目 ID 将其拆分为表以进行报告？

Question

我有一个数据库，它结合了我部门中的所有项目，并且一直在更新。

数据库由 4 列组成：

1. 更新日期
2. 项目名称
3. 参考
4. 状态

假设我们有 4 个项目。

我想要一个 VBA，它将每个项目的所有更新都保存在一个表中。

所以最终它会创建 4 个表，每个项目都有自己的表。它还将项目标题作为表格的标题。

新的 4 个表将包含 3 列

1. 日期
2. 参考
3. 状态

^{（项目标题很常见，因此在新表格中将其删除，并将作为每个表格的标题）}

所以项目编号将是 VBA 的主要搜索条件。

数据库信息由用户表单填充，用户表单插入该数据库中的所有更新。这就是我想根据项目 ID 将数据库拆分为表的原因。由于数据是使用用户表单输入的，用户将通过用户表单中嵌入的下拉列表选择他想要更新的项目，然后提交后，用户表单会将输入的数据插入数据库中。

这个请求的主要目的是得到一个包含所有项目的可打印报告，但每个项目将在单独的表格中以便于分析。Sub report()

Sheet4.Activate


Dim project1 As String
Dim project2 As String
Dim project3 As String
Dim project4 As String
Dim project5 As String
Dim project6 As String
Dim project7 As String
Dim project8 As String
Dim project9 As String
Dim project10 As String
Dim project11 As String
Dim project12 As String
Dim project13 As String
Dim project14 As String
Dim project15 As String

Dim finalrow As Integer

Dim i As Integer

project1 = Sheet4.Range("U1").Value
project2 = Sheet4.Range("U2").Value
project3 = Sheet4.Range("U3").Value
project4 = Sheet4.Range("U4").Value
project5 = Sheet4.Range("U5").Value
project6 = Sheet4.Range("U6").Value
project7 = Sheet4.Range("U7").Value
project8 = Sheet4.Range("U8").Value
project9 = Sheet4.Range("U9").Value
project10 = Sheet4.Range("U10").Value
project11 = Sheet4.Range("U11").Value
project12 = Sheet4.Range("U12").Value
project13 = Sheet4.Range("U13").Value
project14 = Sheet4.Range("U14").Value
project15 = Sheet4.Range("U15").Value


finalrow = Sheet4.Range("A2000").End(xlUp).Row

i = 0

For i = 1 To finalrow
If Cells(i, 1) = project1 Then
Sheet7.Range("A100").End(xlUp).Offset(1, 0) = project1


     If Cells(i, 1) = project1 Then
           Sheet4.Range(Sheet4.Cells(i, 2), Sheet4.Cells(i, 8)).Copy
            Sheet7.Range("A100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

    End If
End If

Next i



Sheet7.Activate





End Sub

Answer 1

从我在这里可以读到的内容以及从数据库的角度来看，为每个项目创建一个新表没有多大意义。这只会让编码变得更加困难。

如果您有一个包含您的项目的表格和另一个包含您的项目详细信息的表格（如果需要），那么您可能会更好。您可以通过唯一标识符链接这些表。因此，您可以通过仅将数据存储在一个表中来避免数据库中的重复条目。现在，您似乎多次存储数据。

Answer 2

你还没有放代码，所以我也不放。 这个想法很简单：

• 创建项目列表。如果你知道有 4 个，你可以把它作为一个固定参数，但是它很难看，最好数一下
• 数一数您将在每个项目中使用的行数
• 创建一个数组数组（ redim A(1 to 4) ，你可以在 VBA 中做到这一点）
• 对于每个项目，重新调整一个大小正确的新数组并正确填充它
• 在项目上循环并将整个数组粘贴到方便的工作表中

祝你好运，如果遇到困难，请随时回来！

按照您的版本：尝试使用数组：

Dim projectList() As String
projectList= Range(Sheet4.Range("U1"),Sheet4.Range("U1").end(xldown)).Value2

项目数量将是ubound(projectlist)

关于循环：在单元格上使用循环非常耗时。我建议你使用：

finalrow = Sheet4.Range("A2000").End(xlUp).Row
dim data()
data=range(Sheet4.Range("A1),Sheet4.Range("A" & finalrow)).value2

对于输出，您可以使用数组并执行两次循环：一次用于计算您必须存储的元素数量，一次用于存储它们。相信我，它会快得多

祝你好运:-)