Question

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

Department  <-- this is K2

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

B      <---k9
B

C     


A    <-- this is K14

这是我的代码

Private Sub 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

Answer 1

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

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上遇到了问题，但我无法确定，因为我看不到实际的数据。
希望这对你有用。

当中间存在空单元格时，vba将数据拆分为多个工作表

1 个答案: