当空白单元格在

之间时，vba会将数据拆分为多个工作表。如果在空白单元格之间存在空格单元格时，我们有问题需要跟踪数据。由于有两个空单元k7和k8，我无法从k9开始追踪数据。从单元格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

来源

2013-10-28 user2766881

你可以添加一个更详细的描述你想要达到的目标吗？我没有足够的技巧来开始调试你的代码。 – CustomX

我正在尝试根据单元格K4中的部门列将表单1中的数据拆分为多个表单。我面临的问题是如果两者之间存在差距，我无法追查数据。示例部门从k4开始到k100，并且在k7和k8之间为空，程序将只追踪从k4到k6的值。 – user2766881

我得到了运行时错误1004. – user2766881

我想你应该改变这种代码：

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-28 08:02:52 L42

两行都是一样的。如果在两种情况下都执行debug.print costc.address，它将返回相同的地址。 – 2013-10-28 08:06:17

它不工作。我仍然无法追踪K9以后的数据。如果k7和k8的值小于k9和k8的值，前提是它不为空。 – user2766881

是的，想通了。嗯...我试着运行你的代码，它做你说它应该做的。它为所有非空白单元格值创建表单。 – L42

当空白单元格在

回答

相关问题