Question

我试图创建一个包含两个条目的表单： - 文件夹号码 - 文件夹中的汤姆斯列表这是为了存档目的。表格分为4部分，将打印在档案盒的标签上。文件夹的编号从1到1500，其中一些文件包含1个文件，其中一些文件最多10个。现在我只需从表格中复制就可以完成此操作：

table

表格中我唯一需要的是此表中的TOM NUMBER

form

我试图使用VLOOKUP，但它只返回搜索文件夹编号的第一行。所以基本上我想要一个函数，它将从标签形式获取文件夹编号，并找到分配给它的所有toms并在下面写。文件夹编号中的前3位数字并不重要，只有最后4位数字被认为是最重要的变量

Answer 1

不幸的是vlookup不起作用，你将不得不使用数组文件夹。我假设你将有一个叫做[文件夹]的表我将创建一个表单，其中包含一些关于如何执行此操作的vba 1.通过选择文件夹数据集并按ctl + T创建表。

Alt + F11进入Visual Basic编辑器
在顶部选择insert ==＆gt;用户窗体
按F4并在属性窗口中命名您的表单FileFinder
如果未选择view =＆gt;您的工具箱可能不会显示工具箱打开
拖动2个标签，2个列表框和2个按钮，您可以根据自己的喜好对其进行格式化
7.创建一个与添加用户窗体相同的新模块，只选择模块
复制粘贴此代码

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

Excel创建自动填充表单

1 个答案: