0

感谢你们和一些在我工作中提供帮助的开发人员，我几乎完成了老板给我的项目。我是一名 QA——不是开发人员——所以我的 VB 脚本专业知识是不存在的。

这是我的问题。我有下面的脚本，它将从销售预算电子表格中为每个地区的每个帐户中的每个客户获取主数据。下面的代码为每个帐户创建一个新工作表并按帐户名称保存。在该工作表中，它将为每个推销员创建一个新工作表。我遇到的两个问题是第一列（称为排名）按降序而不是升序过滤。例如 A:2 是 44，其中 A:2 应该是 1，A:3 应该是 2，A:4 应该是 3，A:5 应该是 4，等等。

这就引出了我的第二个问题。如何让每个电子表格中的第一行成为标题？我希望源工作表第 1 行中的所有内容在它创建的每个工作表中都是第 1 行。这是我想要的行：

秩

CUSTOMER_SEGMENT

ALIAS_NAME（分支）

SUPERVISOR_NAME

销售代表姓名

MAIN_CUSTOMER_NK

顾客

销售量

投资成本 GP

投资成本 GP%

销售增长

“GP点变更”

YTDLY_SALES

YTDLY_INVOICE_COST_GP

在发布之前我进行了搜索，我发现了两个可能对我有帮助的链接。但是，我是新手，无法理解将代码插入到下面现有脚本的位置。

通过 Excel 中的宏向表中添加列时设置列标题

使用宏将标题添加到列数据

如果代码不正确，请原谅我。我是 stackoverflow 格式的新手。\

' 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, 3).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, 5).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, 1)
        Sales.Cells(1, 2).Value2 = Source.Cells(Row, 2)
        Sales.Cells(1, 3).Value2 = Source.Cells(Row, 4)
        Sales.Cells(1, 4).Value2 = Source.Cells(Row, 6)
        Sales.Cells(1, 5).Value2 = Source.Cells(Row, 7)
        Sales.Cells(1, 6).Value2 = Source.Cells(Row, 8)
        Sales.Cells(1, 7).Value2 = Source.Cells(Row, 9)
        Sales.Cells(1, 8).Value2 = Source.Cells(Row, 10)
        Sales.Cells(1, 9).Value2 = Source.Cells(Row, 11)
        Sales.Cells(1, 10).Value2 = Source.Cells(Row, 12)

        '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

以下是来自 CSV 的示例数据：

Rank,CUSTOMER_SEGMENT,ALIAS_NAME (Branch),SUPERVISOR_NAME,Salesrep Name,MAIN_CUSTOMER_NK,Customer,Sales,Inv Cost GP,Inv Cost GP%,Sales Growth,"GP Point Change",YTDLY_SALES,YTDLY_INVOICE_COST_GP 1,TOP 20,Branch1,super1, SR1,416469,3456,886394.26,211430.39,24%,-16%,1%,1056822.44,243333.25 2,TOP 20,Branch1,super1,SR1,223391,3456789,840048.49,11226%,-4.26,13%,2 %,667457.3,115063.42 3,TOP 20,Branch1,super1,SR1,10299,9876,695652.09,88839.65,13%,7%,-2%,648249.35,95599.75 4,TOP 20,Branch1,super1,SR1,430884, 23489,677324.34,91479.62,14%,190%,-2%,233935.32,36550.6 5,TOP 20,Branch2,super2,SR2,415886,89,430334.02,54701.73,13%,-22%,-2%,551546.3 ,80682.7 6,TOP 20,Branch2,super2,SR2,48793,234679,349611.36,61979.82,18%,-6%,2%,370575.07,59370.36 7,TOP 20,Branch2,super2,SR2,433979,29389,323587. ,49952.25,15%,-25%,3%,431745.94,53394.42 8,TOP 20,Branch2,super2,SR2,417290,3565850,304622.89,76255.75,25%,6%,5%,287953.73,57085.9 9,TOP 20,Branch2,super2,SR2,416986,9880,302111.92,45050.53,15%,46%,- 1%,207067.31,32645.16 10,TOP 20,Branch2,super2,SR2,415811,8364859,252760.38,51374.19,20%,-7%,2%,271975.58,49567.85 11,TOP 20,Branch603,super3,SR3,24 ,7369,238166.05,37761.17,16%,-24%,-1%,314515.42,54352.07 12,TOP 20,Branch3,super3,SR3,416363,980897987,237122.47,33682.5,14%,18%,-6%, 201038.61,39941.88 13,TOP 20,Branch3,super3,SR3,428631,2345689,216378.99,25943.35,12%,-37%,-4%,340909.56,54078.63 14,TOP 20,Branch13,super3,SR3,4567832 ,193417.5,37101.67,19%,21%,1%,160318.29,29070.352%,271975.58,49567.85 11,TOP 20,Branch3,super3,SR3,428608,7369,238166.05,37761.17,16%,-24%,-1%,314515.42,54352.07 12,TOP 20,Branch3,super3,SR3, 416363,980897987,237122.47,33682.5,14%,18%,-6%,201038.61,39941.88 13,TOP 20,Branch3,super3,SR3,428631,2345689,216378.99,25943,-45,12%,-3% ,340909.56,54078.63 14,TOP 20,Branch3,super3,SR3,423212,123456789,193417.5,37101.67,19%,21%,1%,160318.29,29070.352%,271975.58,49567.85 11,TOP 20,Branch3,super3,SR3,428608,7369,238166.05,37761.17,16%,-24%,-1%,314515.42,54352.07 12,TOP 20,Branch3,super3,SR3, 416363,980897987,237122.47,33682.5,14%,18%,-6%,201038.61,39941.88 13,TOP 20,Branch3,super3,SR3,428631,2345689,216378.99,25943,-45,12%,-3% ,340909.56,54078.63 14,TOP 20,Branch3,super3,SR3,423212,123456789,193417.5,37101.67,19%,21%,1%,160318.29,29070.35

4

2 回答 2

1

我做了一些修改供你尝试。请注意，我无法对此进行测试，因为我没有您正在处理的工作簿。我已将我的姓名缩写 (CP) 放在评论中，并在其中进行了更改并简要说明。如果您有任何问题，请告诉我：

Option Explicit

' 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 = 1 ' CP changed to not exclude 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, 3).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, 5).Value2

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

        ' insert a blank row at row 1
        'Sales.Rows(1).Insert xlShiftDown ' CP this was causing the reversal

        ' populate said row with the data from the source
        ' CP changed to copy to appropriate row
        Sales.Cells(Row, 1).Value2 = Source.Cells(Row, 1)
        Sales.Cells(Row, 2).Value2 = Source.Cells(Row, 2)
        Sales.Cells(Row, 3).Value2 = Source.Cells(Row, 4)
        Sales.Cells(Row, 4).Value2 = Source.Cells(Row, 6)
        Sales.Cells(Row, 5).Value2 = Source.Cells(Row, 7)
        Sales.Cells(Row, 6).Value2 = Source.Cells(Row, 8)
        Sales.Cells(Row, 7).Value2 = Source.Cells(Row, 9)
        Sales.Cells(Row, 8).Value2 = Source.Cells(Row, 10)
        Sales.Cells(Row, 9).Value2 = Source.Cells(Row, 11)
        Sales.Cells(Row, 10).Value2 = Source.Cells(Row, 12)

        '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
于 2013-08-16T15:19:42.337 回答
0

在创建新工作表的代码中，在此处设置标题：

result.cells(1,1)="header 1"
result.cells(1,2)="header 2"
result.cells(1,3)="header 3"
....

在添加行的代码中，您当前正在插入一行，这会将其余行向下移动，并具有颠倒顺序的效果。为了克服这个问题，我们需要找到将新行添加到哪一行。
首先，dim我们将使用的变量

Dim InsertPos as long

然后我们必须决定我们需要在哪一行放置数据..

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

' Get the location to enter the data
InsertPos = Sales.Range("A1").End(xlDown).Row + 1

'check to see if it's a new sheet, and adjust
if InsertPos=1048577 then InsertPos=2
'change to 65537 is using excel 2003 or before

现在我们可以按照读取的顺序将数据放入工作表中

' populate said row with the data from the source
Sales.Cells(InsertPos, 1).Value2 = Source.Cells(Row, 1)
Sales.Cells(InsertPos, 2).Value2 = Source.Cells(Row, 2)
Sales.Cells(InsertPos, 3).Value2 = Source.Cells(Row, 4)
....
于 2013-08-16T20:30:45.197 回答