引用主表的 Excel 公式

Question

我目前有一个主 Excel 表，其中包含大约 20 个不同销售人员的姓名，每当他们进行销售时，都会创建一个新行，其中 A 列中的销售人员姓名。但是，我现在希望销售人员可以使用这些数据，但我只希望他们只能查看他们的信息，而不是所有人。因此，我将创建 20 个不同的单独文件，每个销售员一个。

每次我更新主表时，是否有一个公式可用于这 20 个不同的电子表格，以便为特定的销售人员更新？

Answer 1

您可以根据唯一值从列（从第 1 行循环到 x）创建工作簿。

因此，对于 A 列中的每个独特销售人员，您都创建了一个新工作簿。然后你只需要使用你当前的主文件，并在该文件中做任何你想做的事情。当您想将工作表发送给销售人员时，您执行代码，Excel 将复制属于特定销售人员的所有行，并为您创建 20 个可以发送的单独工作表。

流程：

我在一个文件夹中有一个文件，里面有我所有的主要数据。

主要数据是这样的，新的工作簿将以A列命名。它只会为唯一名称创建工作簿。

运行宏后，它创建了以下 5 个新工作簿。

这就是工作簿“Anne - 10-27-18,14.24.47.xlsx”的样子：

这就是工作簿“Belle-10-27-18,14.24.47.xlsx”的样子：

I used the following code and only modified to make it dynamic of the unique list column. All credit to J. Fox at SO

VBA 代码：

Option Explicit

Sub ExportByName()
'Source and Credit: https://stackoverflow.com/questions/46368771/how-to-create-a-new-workbook-for-each-unique-value-in-a-column

Dim unique(1000) As String 'How many unique values we can store
Dim wb(1000) As Workbook
Dim ws As Worksheet
Dim x As Long, y As Long, ct As Long, uCol As Long, ColName As Long
Dim StaticDate As Date

On Error GoTo ErrHandler

Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual

'Your main worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")

'Column Where Unique Names are
ColName = 1

uCol = 12 'End column of data in MainFile


ct = 0

'get a unique list of users
For x = 2 To ws.Cells(ws.Rows.Count, ColName).End(xlUp).Row
    If CountIfArray(ActiveSheet.Cells(x, ColName), unique()) = 0 Then
        unique(ct) = ActiveSheet.Cells(x, ColName).Text
        ct = ct + 1
    End If
Next x

StaticDate = Now() 'This create the same timestamp for all the new workbooks

'loop through the unique list
For x = 0 To ws.Cells(ws.Rows.Count, ColName).End(xlUp).Row - 1

    If unique(x) <> "" Then
        'add workbook
        Set wb(x) = Workbooks.Add

        'copy header row
        ws.Range(ws.Cells(1, 1), ws.Cells(1, uCol)).Copy wb(x).Sheets(1).Cells(1, 1)

        'loop to find matching items in ws and copy over
        For y = 2 To ws.Cells(ws.Rows.Count, ColName).End(xlUp).Row
            If ws.Cells(y, ColName) = unique(x) Then

                'copy full formula over
                'ws.Range(ws.Cells(y, 1), ws.Cells(y, uCol)).Copy wb(x).Sheets(1).Cells(WorksheetFunction.CountA(wb(x).Sheets(1).Columns(uCol)) + 1, 1)

                'to copy and paste values
                ws.Range(ws.Cells(y, 1), ws.Cells(y, uCol)).Copy
                wb(x).Sheets(1).Cells(WorksheetFunction.CountA(wb(x).Sheets(1).Columns(uCol)) + 1, 1).PasteSpecial (xlPasteValues)

            End If
        Next y

        'autofit
        wb(x).Sheets(1).Columns.AutoFit

        'save when done
        wb(x).SaveAs ThisWorkbook.Path & "\" & unique(x) & " - " & Format(StaticDate, "mm-dd-yy, hh.mm.ss") & ".xlsx"
        wb(x).Close SaveChanges:=True

    Else
        'once reaching blank parts of the array, quit loop
        Exit For
    End If

Next x

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

ErrHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Public Function CountIfArray(lookup_value As String, lookup_array As Variant)
CountIfArray = Application.Count(Application.Match(lookup_value, lookup_array, 0))
End Function