创建新标签并根据ID输入行的数据

时间:2018-06-28 09:26:56

标签: excel excel-vba excel-formula vba

我有一个带有示例数据的Excel工作表

S.NO.     EXPENDITURE DETAILS    EXPENDITURE ID         EXPENDITURE AMT
1           security unit 22        2252                    200000
2           repairing unit 22       3351                    50000
3           training unity 22       1148                    48000
4           security unit 45        2252                    300000
5           repairing unit 45       3351                    55000
6           training unity 45       1148                    48000
7           security unit 05        2252                    250000
8           repairing unit 05       3351                    60000
9           training unity 05       1148                    48000

我要做的是根据支出ID创建标签,并插入与该支出ID相关的相应行。这只是示例数据,原始文件包含大约35个独立的支出ID。

因此创建的选项卡将为2252,3351,1148,并且与该ID相关的数据应插入该选项卡中。正如Create a new sheet for each unique agent and move all data to each sheet中所引用的那样,我使用了以下代码::

Option Explicit
Sub Move_Each_Agent_to_Sheet()
'   // Declare your Variables
    Dim Sht As Worksheet
    Dim Rng As Range
    Dim List As Collection
    Dim varValue As Variant
    Dim i As Long

'   // Set your Sheet name
    Set Sht = ActiveWorkbook.Sheets("Sheet2")

'   // set your auto-filter,  A6
    With Sht.Range("A2")
        .AutoFilter
    End With

'   // Set your agent Column range # (2) that you want to filter it
    Set Rng = Range(Sht.AutoFilter.Range.Columns(4).Address)

'   // Create a new Collection Object
    Set List = New Collection

'   // Fill Collection with Unique Values
    On Error Resume Next
    For i = 2 To Rng.Rows.Count
        List.Add Rng.Cells(i, 1), CStr(Rng.Cells(i, 1))
    Next i

'   // Start looping in through the collection Values
    For Each varValue In List
'       // Filter the Autofilter to macth the current Value
        Rng.AutoFilter Field:=4, Criteria1:=varValue

'       // Copy the AutoFiltered Range to new Workbook
        Sht.AutoFilter.Range.Copy
        Worksheets.Add.Paste
        ActiveSheet.Name = Left(varValue, 30)
        Cells.EntireColumn.AutoFit

'   // Loop back to get the next collection Value
    Next varValue

'   // Go back to main Sheet and removed filters
    Sht.AutoFilter.ShowAllData
    Sht.Activate
End Sub

,但在每张纸上重复第一行。如何解决这个问题?

0 个答案:

没有答案