根据唯一值创建工作表

时间:2015-07-08 06:37:34

标签: excel vba excel-vba

我有一个按日期排序的数据集,我想根据月份复制数据,即每个月要复制到新工作表的数据,工作表的名称将是当月的名称。 数据集: http://bit.ly/1CoHV5j

我尝试运行以下代码:

Sub x()
Dim rng As Range

With ActiveSheet
    .AutoFilterMode = False
    Sheets.Add().Name = "Temp"
    .Range("H2", .Range("H2").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("A1"), Unique:=True

    For Each rng In Sheets("Temp").UsedRange.Offset(1).Resize(Sheets("Temp").UsedRange.Rows.Count - 1)
        .Range("A1").CurrentRegion.AutoFilter field:=8, Criteria1:=rng
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = rng.Text
        .AutoFilter.Range.Copy Sheets(rng).Range("A1")

    Next rng

    .AutoFilterMode = False
    Application.DisplayAlerts = False
    Sheets("Temp").Delete
    Application.DisplayAlerts = True

End With

End Sub

但是这个错误不断出现:

"您为工作表或图表键入了无效的名称。确保: 您键入的名称不超过31个字符 该名称不包含以下任何字符:\ /? * [ 要么 ] 您不要将名称留空

请帮助并告诉我哪里出错了。

1 个答案:

答案 0 :(得分:1)

某些单元格中的文本可能有保留字符...您可以尝试以下操作,用清理后的字符串替换sheeets.add位

PS:您还应该确保您使用的单元格不是空的

完整代码应该如下所示

Sub x()
    Dim rng As Range
    Dim SheeetName as string    
    With ActiveSheet
    .AutoFilterMode = False
    Sheets.Add().Name = "Temp"
    .Range("H2", .Range("H2").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("A1"), Unique:=True
    For Each rng In Sheets("Temp").UsedRange.Offset(1).Resize(Sheets("Temp").UsedRange.Rows.Count - 1)
        .Range("A1").CurrentRegion.AutoFilter field:=8, Criteria1:=rng
        SheeetName = GetGoodSheetName(rng.Text)
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = SheeetName
        .AutoFilter.Range.Copy Sheets(SheetName).Range("A1")

    Next rng

    .AutoFilterMode = False
    Application.DisplayAlerts = False
    Sheets("Temp").Delete
    Application.DisplayAlerts = True
    End With
End Sub

Function GetGoodSheetName(fromName As String) As String
    Dim objRegex As Object
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Global = True
        .Pattern = "[\<\>\*\\\/\?|]"
        GetGoodSheetName = .Replace(fromName, "_")
    End With
End Function