Excel創建自動填充表單

Question

我試圖創建一個包含兩個條目的表單： - 文件夾號碼 - 文件夾中的toms清單 這是爲了歸檔目的。表格分爲4個部分，將打印在歸檔盒的標籤上。 文件夾編號從1到1500，其中一些含有1名湯的文件，其中一些人到10。現在，我通過它看起來像這樣的表只複製這樣做manualy：

table

我需要在形式上唯一的事情是TOM NUMBER從表中

form

我試圖用VLOOKUP，但它只返回已搜索文件夾數第一排。 所以bascially我想要一個函數，將採取從標籤形式的文件夾號碼，並找到所有的toms被分配並寫在下面。文件夾號碼中的前3位並不重要，只有最後4位被認爲是最重要的變量

Answer 1

不幸的是，vlookup無法正常工作，您將不得不使用數組文件夾。我假設你將有一個名爲[文件夾] 的表格，並且我將創建一個帶有一些vba的表單表單，以便如何執行此操作。
1.通過選擇文件夾數據集並按下ctl + T創建表。

Alt + F11進入的Visual basic編輯

在頂部選擇插入==>用戶窗體

，按F4鍵，在屬性窗口命名形式FileFinder如果不選擇視圖

你的工具箱maynot出現=>工具箱打開

拖2個標籤，列表框2和2個按鈕，你可以格式化你喜歡的。

7.Create一個新的模塊一樣添加用戶窗體只能選擇模塊

複製粘貼此代碼

Public Function CreateWorksheet(Optional name As String = "") As Worksheet Dim ws As Worksheet Set ws = ThisWorkbook.Sheets.Add If name <> "" Then ws.name = name Set Create = ws End Function Public Function LastRow() As Integer 'gets last row from column A LastRow = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row End Function Public Function DistintFolders() As String() Dim list() As String Dim counter As Integer For Each cell In ActiveSheet.Range("E2:E" & LastRow) If Not IsInList(list, cell.Value, counter) Then counter = counter + 1 ReDim Preserve list(1 To counter) list(counter) = cell.Value End If Next cell DistintFolders = list End Function Public Function TomNumberByFolder(folderName As Variant) As String() Dim list() As String Dim counter As Integer Dim rowNumber As Integer For Each cell In ActiveSheet.Range("B2:B" & LastRow) rowNumber = rowNumber + 1 If IsCorrectFolder(folderName, rowNumber) Then counter = counter + 1 ReDim Preserve list(1 To counter) list(counter) = cell.Value End If Next cell TomNumberByFolder = list End Function Public Function IsInList(ByRef list() As String, compare As String, count As Integer) As Boolean Dim l As Variant If compare = "" Then IsInList = True Exit Function End If If count = 0 Then IsInList = False Exit Function End If For Each l In list If l = compare Then IsInList = True Exit Function End If Next l IsInList = False End Function Public Function IsCorrectFolder(folderName As Variant, rowNumber As Integer) As Boolean IsCorrectFolder = (ActiveSheet.Range("E" & rowNumber).Value = folderName) End Function

雙擊窗體並粘貼此代碼

`

Private Sub btnCancel_Click() 
    Unload Me 
End Sub 

Private Sub btnCreate_Click() 
Dim ws As Worksheet 
    If lstTom.ListCount = 0 Then 
     MessageBox "Please select a folder" 
    End If 
    Set ws = ThisWorkbook.Sheets.Add 
    ws.Cells(1, 1).Value = "Tom Number" 

    ws.Cells(2, 1).Resize(Me.lstTom.ListCount, 1) = Me.lstTom.list 
End Sub 

Private Sub lstFolder_Click() 
    Dim folder As String 
    If ActiveSheet.name <> "Data" Then ThisWorkbook.Sheets("Data").Activate 'please name this whatever your datasheet is called 
    For i = 0 To lstFolder.ListCount - 1 
     If lstFolder.Selected(i) Then 
      Me.lstTom.Clear 

     For Each s In TomNumberByFolder(lstFolder.list(i)) 
       With lstTom 
        .AddItem s 
       End With 
      Next s 
     End If 
    Next i 
End Sub 

Private Sub UserForm_Initialize() 

    For Each s In DistintFolders 
     With lstFolder 
      .AddItem s 
     End With 
    Next s 
End Sub 

`
請注意，您可能需要更改表名稱，如果你想我會送你這個。

Download Here