0

当中间有空白单元格时，我无法追踪数据。我无法从 k9 开始追踪数据，因为有两个空单元格 k7 和 k8。有从单元格 A 到 K 的数据。单元格 K 是新工作表的主要因素和名称。单元格 A 到 J 是其他数据，例如姓名、时间、办公室等。单元格 A2 到 K2 将是标题。单元格将被拆分为工作表 A、B 和 C。

Department  <-- this is K2

A     <--- this K4
B
C      
       <---k7
       <---k8

B      <---k9
B

C     


A    <-- this is K14

这是我的代码

私有子 CommandButton1_Click()

Dim ws As Worksheet, Rng As Range, cc
Dim temp As Worksheet, CostC As Range, u

Set ws = Sheets("Sheet1") 'where your original data. adjust to suit
Set Rng = ws.Range("a1").CurrentRegion.Resize(, 15)
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 15) '<<add
Set CostC = ws.Range("k4", ws.Range("k" & Rows.Count).End(xlUp))

u = UNIQUE(CostC)
Application.ScreenUpdating = 0
For Each cc In u
    With Rng
        .AutoFilter field:=11, Criteria1:="=" & cc
        On Error Resume Next
        Set temp = Sheets(cc)
        On Error GoTo 0
        If Not temp Is Nothing Then

DoThis:

        .SpecialCells(xlCellTypeVisible).Copy temp.Range("A1")
        Else
            Set temp = Sheets.Add
            temp.Name = cc
            GoTo DoThis
        End If
        .AutoFilter
    End With
    Set temp = Nothing
Next
Application.ScreenUpdating = 1

End Sub

Function UNIQUE(r As Range)
Dim a, v
If IsArray(r.Value) Then
    a = r.Value
    With CreateObject("scripting.dictionary")
        .comparemode = vbTextCompare
        For Each v In a
            If Not IsEmpty(v) Then
                If Not .exists(v) Then .Add v, Nothing
            End If
        Next
        If .Count > 0 Then UNIQUE = .keys
    End With
    Erase a
Else
    UNIQUE = r.Value
End If

End Function
4

1 回答 1

0

我认为您应该更改此代码：

Set CostC = ws.Range("k4", ws.Range("k" & Rows.Count).End(xlUp))

对此：

Set CostC = ws.Range("K4:K" & ws.Range("K" & Rows.Count).End(xlUp).Row)

更新：

根据您在下面的评论，更改此：

Set Rng = ws.Range("a1").CurrentRegion.Resize(, 15)
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 15)

对此代码：

Set Rng = ws.Range("A2:O" & ws.Range("K" & Rows.Count).End(xlUp).Row)

我认为我们在 CurrentRegion 上遇到了问题，但我无法确定，因为我看不到实际数据。
希望这对你有用。

于 2013-10-28T08:02:52.437 回答