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