1

我是QA。我不是开发人员，但我向老板请教了一些繁忙的工作。她给了我一个开发项目，我完全糊涂了。我们有一个包含一长串销售人员及其客户的电子表格。对于每个客户，销售人员、客户名称、销售额和位置如下所示：

Salesperson    Customer Name    Sales Amount   Location

salesperson1   customerA        3456789        Atlanta

salesperson1   customerB        9475903        Atlanta

salesperson1   customerC        7236433        Atlanta

salesperson1   customerD        9809489        Raleigh

salesperson2   customerA        3456789        Raleigh

salesperson2   customerB        9475903        Raleigh

salesperson2   customerC        7236433        Raleigh

salesperson2   customerD        9809489        Raleigh

salesperson2   customerE        3456789        Raleigh

salesperson3   customerA        9475903        Portland

salesperson3   customerB        7236433        Portland

salesperson3   customerC        9809489        Portland

salesperson4   customerA        9475903        Portland

salesperson4   customerB        7236433        Portland

salesperson4   customerC        9809489        Portland

这个电子表格上有数百行销售人员和客户。我的工作是创建一个新的工作簿模板。我已经成功地做到了。该模板采用相对销售数据并根据销售数字进行计算。目前，我已经能够将所有数据从源中获取到模板中，并且计算工作正常。但是，我需要更进一步。对于每个销售人员，我需要将数据加载到单独的工作表中，并且每个位置都需要一个单独的模板。例如：请注意 salesperson3 和 salesperson 4 在波特兰位置。我需要一个单独的销售人员 3 工作表和一个销售人员 4 的单独工作表，该工作簿需要保存为 PORTLAND.XLSM。还需要一个名为 RALEIGH.XLSM 和 ALTANTA.XLSM 的模板。

所以这是我的问题：

  1. 当我从 salesperson1 到 salesperson2 再到 salesperson3 到 salesperson4 时，如何制作一个数组来引起注意？
  2. 我该如何做一个阵列来消除不在该位置的任何人？我认为每个位置都需要一个工作表，如果工作表的名称与该销售人员的位置不匹配，则该销售人员不会在该工作簿中获得工作表。

自从大约 2 年前我上大学以来，我就没有使用过 VB。我知道逻辑，但我不知道语言和语法。

4

3 回答 3

0

这将遍历源工作表（活动工作表）并生成许多工作簿（每个位置一个）。将包含每个销售人员的客户名称和销售额的工作表添加到工作簿中。

生成工作簿后，它会将它们保存为它们的位置名称。

' get a named worksheet from specified workbook, creating it if required
Public Function GetSheet(ByVal Name As String, ByVal Book As Workbook, Optional ByVal Ignore As Boolean = False) As Worksheet
Dim Sheet As Worksheet
Dim Key As String
Dim Result As Worksheet: Set Result = Nothing

    Key = UCase(Name)

    ' loop over all the worksheets
    For Each Sheet In Book.Worksheets
        ' break out of the loop if the sheet is found
        If UCase(Sheet.Name) = Key Then
            Set Result = Sheet
            Exit For
        End If
    Next Sheet

    ' if the sheet isn't found..
    If Result Is Nothing Then
        If Ignore = False Then
            If Not GetSheet("Sheet1", Book, True) Is Nothing Then
                ' rename sheet1
                Set Result = Book.Worksheets("Sheet1")
                Result.Name = Name
            End If
        Else
            ' create a new sheet
            Set Result = Book.Worksheets.Add
            Result.Name = Name
        End If
    End If

    Set GetSheet = Result

End Function


Sub Main()
Dim Source As Worksheet
Dim Location As Workbook
Dim Sales As Worksheet
Dim LocationKey As String
Dim SalesKey As String
Dim Index As Variant
Dim Map As Object: Set Map = CreateObject("Scripting.Dictionary")
Dim Row As Long

    Set Source = ThisWorkbook.ActiveSheet

    Row = 2 ' Skip header row

    Do
        ' break out of the loop - assumes that the first empty row signifies the end
        If Source.Cells(Row, 1).Value2 = "" Then
            Exit Do
        End If

        LocationKey = Source.Cells(Row, 4).Value2

        ' look at the location, and find the workbook, creating it if required
        If Map.Exists(LocationKey) Then
            Set Location = Map(LocationKey)
        Else
            Set Location = Application.Workbooks.Add(xlWBATWorksheet)
            Map.Add LocationKey, Location
        End If

        SalesKey = Source.Cells(Row, 1).Value2

        ' get the sheet for the salesperson
        Set Sales = GetSheet(SalesKey, Location)

        ' insert a blank row at row 1
        Sales.Rows(1).Insert xlShiftDown

        ' populate said row with the data from the source
        Sales.Cells(1, 1).Value2 = Source.Cells(Row, 2)
        Sales.Cells(1, 2).Value2 = Source.Cells(Row, 3)

        'increment the loop
        Row = Row + 1
    Loop

    ' loop over the resulting workbooks and save them - using the location name as file name
    For Each Index In Map.Keys
        Set Location = Map(Index)
        Location.SaveAs Filename:=Index
    Next Index

End Sub

更新

仅当您生成只读报告时，此代码才真正有用，每次生成报告时都会被替换。（此代码可能无法在后续运行中保存，因为它在尝试保存时不检查文件是否存在，您需要在再次运行之前删除任何先前的输出）。

Main()需要将此代码（以其当前形式）与源数据一起添加到工作簿中，并且在运行宏之前数据表需要处于活动状态。

如果您尝试做的不仅仅是生成报告（例如用新文件替换源数据表），那么在 Access 中会更简单，正如一些人已经建议的那样。

于 2013-08-08T21:12:12.953 回答
0

这是一个使用不需要 VBA 的数据透视表的选项。如果您使用它，维护需要更多的工作，但设置和移交非常简单：

  1. 从您的源中，制作一个数据透视表并将其添加到新文档中。
  2. 对于您的Report Filter，添加SalesPerson和Location。暂时将实际下拉列表保留在 (All) 或只是随机选择值。
  3. 对于您的Row 标签，您可以添加Customer。
  4. 对于您的Values，您可以汇总您的销售额。
  5. 使标签尽可能漂亮。这将是所有销售人员的模板。选项功能区可让您添加自定义计算、行总数百分比等。尽情发挥吧。您现在有一个标签，可以作为每个销售人员的模板！
  6. 为每个位置制作一个空白工作簿。对于每个位置的工作簿，为在那里工作的每个销售人员添加此模板选项卡。在该选项卡的数据透视表过滤器中，选择位置和销售人员。
  7. 重复 #6，直到每个工作簿都有一个针对每个销售人员的选项卡，并且每个选项卡都选择了正确的销售人员和位置。

是的，这很单调，但现在你已经完成了最困难的部分！每个销售人员都有自己的标签，每个位置都有自己的文件。感谢您刚刚创建的许多选项卡中的报告过滤器，每个选项卡都被过滤为该销售人员在该位置的销售。

更新数据：

此选项的最大缺点是每次销售人员开始在新位置销售或雇用新销售人员时，您都必须添加一个新选项卡。但是由于您的通用模板选项卡，这并不是很痛苦。

对于定期更新，只需打开每个文件并转到数据功能区并全部刷新。

于 2013-08-08T22:01:32.740 回答
0

正如布拉德所说，这将是一个需要维护的野兽。话虽如此，如果我正确理解您的问题，我会使用 .Range() 函数。如果您将数据放在表中，则可以拉出一个数组并使用此函数执行您要查找的操作。

Public Sub createSheets()
    Dim salespersons As Range, location As String, fileLocation As String, salesperson As String, newSheet As Worksheet

    Set salespersons = Range("Table1[Salesperson]")

    For i = 1 To salespersons.Count
        location = salespersons(i).Offset(0, 3).Value
        If i = 1 Or (salespersons(i).Offset(0, 3).Value <> salespersons(i - 1).Offset(0, 3).Value) Then
            Call createBook(location)
        End If
    Next i
    For Each wbook In Application.Workbooks
        For i = 1 To salespersons.Count
            If i = 1 Or (i > 1 And salespersons(i) <> salespersons(i - 1)) Then
                salesperson = salespersons(i).Value
                location = salespersons(i).Offset(0, 3).Value

                If location & ".xlsx" = wbook.Name Then
                    If i = 1 Or (salespersons(i).Value <> salespersons(i - 1).Value) Then
                        On Error Resume Next
                        Set newSheet = wbook.Worksheets(salesperson)
                        If Err.Number <> 0 Then
                            Set newSheet = wbook.Worksheets.Add
                            newSheet.Name = salesperson
                        End If
                    End If
                End If
            End If
        Next i
    Next
End Sub

Public Sub createBook(location As String)
    Dim newBook As Workbook, newSheet As Worksheet, result1 As Boolean, result2 As Boolean


    result1 = isWorkbookOpen(location & ".xlsx")

    If result1 = False Then
        On Error Resume Next
        Workbooks(location).Save
        If Err.Number <> 0 Then
            On Error Resume Next
            Workbooks.Open (location & ".xlsx")
            If Err.Number <> 0 Then
                Workbooks.Add.SaveAs (location & ".xlsx")
                Error Err.Number
            End If
        End If
    End If
End Sub

Function isWorkbookOpen(location As String)
    Dim ff As Long, Errno As Long

    On Error Resume Next
    ff = FreeFile()
    Open Filename For Input Lock Read As #ff
    Close ff
    Errno = Err
    On Error GoTo 0

    Select Case Errno
        Case 0:
            isWorkbookOpen = False
        Case 70:
            isWorkbookOpen = True
        Case 75:
            isWorkbookOpen = False
        Case Else: Error Errno
    End Select
End Function
于 2013-08-09T02:55:35.197 回答