當空白單元格在

之間時，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

當空白單元格在

回答

相關問題