请教各位老师，根据总表按日期拆分明细表

assgh1

lsc900707 发表于 2017-4-20 16:30
代码修改好了，正在审核中，先把附件上传供参考。

Private Sub Worksheet_Activate()
    Dim Rng As Range
    Dim i As Integer
   
    For Each Rng In Range("B2:B20")
        If Application.WorksheetFunction.CountA(Rng) = 0 Then
            Rows(Rng.Row).EntireRow.Hidden = True
        End If
    Next
End Sub
能帮忙修改一下这代码，运用到每个工作表吗？就是指定区域为空值就隐藏

lsc900707

assgh1 发表于 2017-4-20 23:06
Private Sub Worksheet_Activate()
    Dim Rng As Range
    Dim i As Integer

是指上例中各分表隐藏空白单元格吗？

assgh1

是呀，因为模板的行数是固定的，所以把多余的行数隐藏

assgh1

lsc900707 发表于 2017-4-21 05:03
是指上例中各分表隐藏空白单元格吗？

是的，因为模板行数固定的，所以把多出来的隐藏

lsc900707

assgh1 发表于 2017-4-21 06:58
是的，因为模板行数固定的，所以把多出来的隐藏

不要另外写代码，加到一起处理吧：

1. Sub 拆分为工作表()
   
2. Application.ScreenUpdating = False
   
3. Application.DisplayAlerts = False
   
4. For Each sh In Worksheets
   
5. If sh.Name <> "模板" And sh.Name <> "Sheet1" Then sh.Delete
   
6. Next
   
7. Sheet1.Range("A2:G" & Sheet1.Range("B65536").End(xlUp).Row).Sort Key1:=Range("B1"), Order1:=xlAscending
   
8. n = 2
   
9.     With ThisWorkbook.Sheets("Sheet1")
   
10.         For Each b In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
    
11.             u = b.Row
    
12.             If b <> b.Offset(1, 0) Then
    
13.             Sheets("模板").Copy After:=Sheets(Worksheets.Count)
    
14.                 .Rows(n & ":" & u).Copy Sheets(Sheets.Count).Range("a4")
    
15.                 Sheets(Sheets.Count).Name = Format(b, "m月d日")
    
16.                  n = u + 1
    
17.             End If
    
18.         Next
    
19.     End With
    
20.     For Each sh In Sheets
    
21.         If sh.Name <> "模板" And sh.Name <> "Sheet1" Then
    
22.              With sh
    
23.                  k = .Range("a65536").End(xlUp).Row
    
24.                  arr = .UsedRange
    
25.                  For i = 4 To UBound(arr)
    
26.                      For j = 5 To 7
    
27.                          If IsNumeric(.Cells(i, j)) Then
    
28.                              .Cells(k - 3, j) = Application.Sum(Application.Index(arr, , j))
    
29.                          End If
    
30.                      Next
    
31.                  Next
    
32.                  For k = 4 To 10
    
33.                      If .Cells(k, 2) = "" Then
    
34.                          .Rows(k).Hidden = True
    
35.                      Else
    
36.                          .Rows(k).Hidden = False
    
37.                      End If
    
38.                  Next
    
39.             End With
    
40.         End If
    
41.     Next
    
42. Application.ScreenUpdating = True
    
43. Application.DisplayAlerts = True
    
44. End Sub

复制代码