从工作表信息创建文件目录答案

【问题标题】：Creating File Directory from Worksheets Information从工作表信息创建文件目录
【发布时间】：2018-07-28 23:16:17
【问题描述】：

我正在尝试编写一个脚本，以根据我在 excel 中创建的表单信息自动创建一个文件目录。

文件结构是什么样的

表单是什么样子的

我有一个脚本，它会在我提取信息后创建文件目录。我只需要有关将提取信息并将其复制到我的文件目录表上的 A 列的脚本的帮助。表格的 A9 将始终是文件夹的名称，子文件夹将是产品数据、车间图纸、样品、保修或材料证书。不过，并非所有表单都包含所有表单。

如果工作表有产品数据，我的想法是使用 if 函数，它将 A9/productdata 放置到文件目录中。我需要它为工作簿中的每个工作表执行此操作。

Sub FileDirectory()

    Dim ws As Worksheet
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "File Directory" Then
            ws.Range("A9").Copy Sheets("File Directory").Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
    Next
    Application.ScreenUpdating = True

End Sub

这是我将 A9 从每个工作表复制到文件目录的情况。我不知道如何创建 if 来创建子文件夹。任何帮助将不胜感激！

【问题讨论】：

如果子文件夹名称是唯一的，也许您可以使用Range.Find 方法查看它们是否存在，如果存在，则与主文件夹名称连接。或者，如果它们始终在同一个单元格中，请检查该单元格。
不确定我是否理解，但从 i.stack.imgur.com/rI2i6.png 你想要文件夹 09 24 00 PORTLAND CEMENT PLASTER, 09 24 00 PORTLAND CEMENT PLASTER\PRODUCT DATA, 09 24 00 PORTLAND CEMENT PLASTER\SAMPLES, 09 24 00波特兰水泥石膏\材料证书和 09 24 00 波特兰水泥石膏\提交说明。对吗？
子文件夹名称将是产品数据、样品、车间图纸或材料证书。但并非所有表单都会使用每个子文件夹。父文件夹名称将始终位于单元格 A9 中。我将有一本包含所有表格的工作簿。我需要脚本从第一页开始并将该表的 A9 复制到我的文件目录表中。然后检查它将在该表上使用哪些子文件夹，并将父文件夹名称/子文件夹名称放在它后面，就像图片一样，然后转到下一张表。
您是您的主题的专家。请接受其他人不是。除了A9，我们如何扣除需要创建的子文件夹？
很抱歉，我试图以一种有意义的方式进行解释，因此除了 A9 中的名称会不同并且他们可能不会使用每个部分之外，每个表单都是相同的。这些部分由灰色标题分隔。 B 列中的标题只有 5 个选项，产品数据、样品、车间图纸、材料数据或保修。例如，此表格使用产品数据、样品和材料证书。我需要制作一个脚本来搜索每个表单，这将是它自己的工作表，并将信息粘贴到我的文件目录工作表的 A 列中。

标签： vba excel if-statement range

【解决方案1】：

如果子文件夹名称在 A 列中，下面的代码应该适合您。

Sub FileDirectory()

Dim ws As Worksheet
Dim subfolders() As String
Dim cell As Range, i As Integer

subfolders = Split("PRODUCT DATA,SAMPLES,SHOP DRAWINGS,MATERIAL CERTIFICATES", ",")

Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "File Directory" Then
        ws.Range("A9").Copy Sheets("File Directory").Cells(Rows.Count, "A").End(xlUp).Offset(1)
        For Each cell In ws.Range("A:A") 'Changing this cell range to a smaller, defined range will improve performance
            For i = LBound(subfolders) To UBound(subfolders)
                If cell.Value = subfolders(i) Then
                    Sheets("File Directory").Cells(Rows.Count, "A").End(xlUp).Offset(1) = ws.Range("A9").Value + "/" + cell.Value
                End If
            Next i
        Next cell
    End If
Next

Application.ScreenUpdating = True

结束子

【讨论】：

感谢它的魅力！这将节省我很多工作时间。