創建一個VBA來篩選數據庫並根據項目ID將其拆分爲表以進行報告？

Question

我有一個數據庫，將我所在部門的所有項目都組合起來，這個項目一直在更新。 4列

的數據庫包括：

1. 更新
2. 項目名稱
3. 參考
4. 狀態的日期

假設我們有4個項目。

我想要一個VBA，它將每個項目的所有更新都放在一個表中。

所以最終它會創建4個表格，每個項目都會有自己的表格。此外，它還會將項目標題作爲表格的標題。

新的4個表將包括3列

1. 日期
2. 的參考
3. 狀態

^{（項目名稱將是共同的，這就是爲什麼它在新表中刪除內容它將作爲每個表的標題）}

因此，項目編號將成爲VBA的主要搜索條件。

數據庫信息由用戶窗體填滿，用戶窗體插入該數據庫中的所有更新。這就是我想根據項目ID將數據庫拆分成表的原因。由於數據是使用用戶窗體輸入的，因此用戶將通過用戶窗體中的嵌入式下拉列表選擇要更新的項目，然後在提交後，用戶窗體將輸入的數據插入到數據庫中。

這一要求的主要目的是有一個可打印的報告，結合所有的項目，但每個項目將在單獨的表更容易analysis.Sub報告（）

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

你還沒有把代碼，所以我也不會放任何。 這個想法很簡單：

• 創建一個項目列表。如果你知道有4個，你可以用它作爲一個固定參數，但它很醜，更好計數
• 計算你將在每個項目上的線數
• 創建一個數組數組（redim A 4），你可以爲每個項目做，在VBA）
• ，REDIM正確尺寸的新數組並填寫正確
• 上項目環和全陣列粘貼方便工作

祝你好運，並隨時回來，如果你有困難的話！以下

您的版本：儘量使用數組：

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 

以及輸出，你可以使用數組和做循環兩次：一次算你有多少個元素來存儲，一個存儲它們。相信我，這將是非常非常快

好運:-)

Answer 2

從我可以讀這裏相對於數據庫的角度來看，它並沒有多大意義，以創建一個新表的每一個項目。這在編碼過程中變得更加困難。

如果您的項目和其他表格（如有必要）包含您的項目的詳細信息，您可能會更好。您可以通過唯一標識符鏈接這些表格。因此，通過僅將數據存儲在一個表中，可避免數據庫中的重複條目。現在，它看起來像你多次存儲你的數據。