Question

我想创建一个宏，该宏将打开一个文件夹中的所有excel书籍，读取填充的信息并将它们存储在代表我的数据库的工作表中。我需要了解您的建议以及实现此目的的最佳方法是什么，以获得快速而灵活的结果。

为帮助您理解我的问题，让我们假设我有3个excel模板，其中包含名字，姓氏和国家/地区，但位于这些图片的不同位置

模板1

模板2

模板3

基于此，我想得到的最终结果是：

这些图片所给出的示例确实非常简单，但这只是为了帮助您了解我想要的。现在，我将详细介绍真正的需求。实际上，我有3个模板，但是每个模板都包含大约80个数据字段（不只是名字，姓氏和国家）。而且我不必只读取3个文件，但是我必须读取放置在一个文件夹中的大约200个文件，每个文件要么是template1，要么是2或3。将来我们可能会有一个模板4，这就是为什么我需要灵活的东西。

我考虑过命名范围，但是模板1,2,3已经存在，并且我无法从200个用户中收集200个现有的excel文件，并且在启动宏之前，无法将命名范围赋予80字段在每个文件。我可以使用命名范围，如果将来它们将是模板4，那么在将文件发送给将填充Excel的最终用户之前，我们先将范围命名并发送给他，但是在模板4之前，我必须修复当前的三个现有模板的问题。

我还考虑过基于列和行索引读取数据，例如，我检查文件的类型，如果正在读取文件模板，则从单元格（2,3）中获取名字，如果是模板2，我从单元格（5,6）中获取信息，如果是模板3，我从Cel（9,4）中获取信息，但是问题是我的代码根本不灵活。

我还说过，我可能会像称为参考的工作表那样工作，在该工作表中，我根据模板模型定义每个字段的位置，例如，我说名字是模板1的名称，位于位置2,3处。模板2的名字是5,6，而template3的名字是9,4。如下图所示，当我遍历我的200个文件时，我检查了是否是模板1我已阅读参考表，并且知道名字将在此位置，与模板2相同，依此类推... 。此解决方案看起来像上一个解决方案，但是更灵活，因为如果有任何更改，我们要做的就是更改参考表，但是我想知道如果对于每个字段我都必须读取2个单元格，它是快速还是慢速？参考表了解位置。

我真的迷路了，因为在开始编码之前，我必须选择最好的方式来做自己想要的事情，以避免浪费时间。如果有专家可以告诉我什么是最好的，或者给我更多的想法，而不是我的想法，我将不胜感激。

预先感谢任何帮助者

编辑： @PEH，如果我将查找表做成这样，您会怎么想？

EDIT2： @PEH，这就是最近评论中建议的内容

Answer 1

基本概念（除了循环浏览文件）：

将您的查找数据更改为以下内容：

然后阅读Cells(1, 6)以获得模型。

Dim Model As String
Model = Worksheets("MyTemplate").Cells(1, 6).Value

使用WorksheetFunction.Match method在查找表中查找您的字段。

Dim FieldRow As Long
FieldRow = Application.WorksheetFunction.Match(Model & "-First name", Worksheets("LookupTable").Range("A:A"), 0)

使用...

fRow = Worksheets("LookupTable").Cells(FieldRow, 2)
fColumn = Worksheets("LookupTable").Cells(FieldRow, 3)

在模板中查找该字段的行和列。

如果将字段查找内容放入方便的函数中，则代码将更易于维护。例如，将以下内容放入模块：

Option Explicit

Public LookupCache As Variant
Public LookupResults As Variant

Public Function ReadField(Ws As Worksheet, FieldName As String) As Variant
    'Here we cache the lookup table. It reads the sheet LookupTable into an 
    'array if the array does not exist yet. If the function runs a second time,
    'the array exists already and is used directly (saves time).
    'Lookup in arrays is much faster than in cells.
    'Caching makes this function about 2 times faster than without.
    If IsEmpty(LookupCache) Or IsEmpty(LookupResults) Then
        With ThisWorkbook.Worksheets("LookupTable")
            Dim LastLookupRow As Long
            LastLookupRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            LookupCache = .Range("A2", "A" & LastLookupRow).Value
            LookupResults = .Range("B2", "C" & LastLookupRow).Value
        End With
    End If

    Dim ModelName As String
    ModelName = Ws.Cells(1, 6).Value

    Dim LookupRow As Long
    On Error Resume Next
    LookupRow = Application.WorksheetFunction.Match(ModelName & "-" & FieldName, LookupCache, 0)
    On Error GoTo 0

    If LookupRow = 0 Then
        'field not found
        ReadField = CVErr(xlErrNA)
        Exit Function
    End If

    Dim fRow As Long, fColumn As Long
    fRow = LookupResults(LookupRow, 1)
    fColumn = LookupResults(LookupRow, 2)

    ReadField = Ws.Cells(fRow, fColumn).Value
End Function

因此您可以阅读

之类的字段

Debug.Print ReadField(MyLoopWorkbook.Worksheets("MyTemplate"), "First name")
'MyLoopWorkbook should be the current workbook in your files loop

根据评论进行编辑……

如果我们向新模型4添加了新字段Company，则用户必须转到工作表查找表，并在第11行的行和列中添加Model4-Company，同时在其具有的代码中去添加ReadField(MyLoopWorkbook.Worksheets("MyNewTemplate"), "Company")，对吗？这就是为什么我不理解如何只能依靠那些不编写代码的人的原因？请您澄清一下，因为您说的话确实很重要。

如果将ReadField部分设为动态，则无需在此处进行编码。例如，如果您想得到一个像这样的表：

您只需在第4列中添加一个新标题即可，例如Company等字段。并编写一个循环遍历该标题行的列以收集所有字段的循环。

Sub ReadAllFields()
    Dim wsData As Worksheet
    Set wsData = Worksheets("CollectedData")

    Dim FreeRow As Long 'find next free row in table
    FreeRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row + 1

    Dim Fields() As Variant 'read headers into array
    Fields = wsData.Range("A1", wsData.Cells(1, wsData.Columns.Count).End(xlToLeft)).Value

    Dim iCol As Long
    For iCol = 1 To UBound(Fields, 2) 'loop through header columns
        wsData.Cells(FreeRow, iCol).Value = ReadField(MyLoopWorkbook.Worksheets("MyNewTemplate"), Fields(1, iCol)) 
        'reads fields dynamically depending on which headers exist in data sheet
    Next iCol
End Sub

VBA-Excel从不同位置的不同工作表中获取相同的数据

1 个答案: