求高手帮忙:如何根据条件插入行[已解决啦]

zxyhyuan

    我发上来的是我们这里的文化户口册,在打印时需要一户打印在一页上,我想每页设成15行,请高手帮帮忙为谢!
用下面这段代码就可以了
Sub 打印()
Dim x As Integer
Dim myRange As Range
Dim myUnion As Range
Dim c As Range
On Error Resume Next
Sheets("文化户口册 ").Select
irow1 = Sheets("文化户口册 ").[b65536].End(xlUp).Row

For i = 1 To irow1 Step 1
If Sheets("文化户口册 ").Cells(i, 2) = "户主" Then
y = i - 14
Set myRange = Range(Cells(y, 2), Cells(i - 1, 2))
myRange.Activate
Set c = myRange.Find(What:="户主", LookIn:=xlFormulas)
   c.Activate
   
x = c.Row
Z = i + (14 - (i - x))
If i - x < 15 Then
     
  Set myUnion = Range(Cells(i, 1), Cells(Z, 20))
  myUnion.Activate
  myUnion.Select
   Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
   

End If
  
End If

Next i

End Sub

zxyhyuan

A9单元格里的1为第一户,这一户一直到A15那一行,这里只有7行,要在这7行之后插入8行空白,才够一页,每页15行,第二户就是从A16开始.这样循环下去,(就是两个户主之间要隔14行),请高手帮忙,以户主为参照编一个程序,谢谢!

zxyhyuan

请高手帮帮忙，急用

pureshadow

只是为了打印么，不需要插入行，到分页预览里设置一下就好了。

zxyhyuan

请问楼主:怎么设

zxyhyuan

我想应该可以用VBA代码实现,因为数据量很大,全镇有将近一万户.如果用手工排要两天才能排完.请高手指教

zxyhyuan

请高手检查一下这段代码,错在什么地方,谢谢Sub 文化户口册打印()
Dim x As Integer
Dim y As Integer

   Application.DisplayAlerts = False '取消警告对话框
    Application.ScreenUpdating = False '取消屏幕更新

  For Each rw In Worksheets(文化户口册).Cells(1, 1).CurrentRegion.Rows
     this = rw.Cells(9, 2).Value = "户主"
      x = rw.Cells(9, 2).Rows
      y = x - 14
      
      Set myRange = Worksheets(文化户口册).Range("B" & y & ":B" & x - 1)
      answer = Application.WorksheetFunction.HLookup("户主", myRange, 1, False)
        
        If this = answer Then rw.Insert shift:=xlDown
        this = answer
        Next
        End Sub

zxyhyuan

楼上代码提示:下标越界

zhufree

拿个文件来比较好，

pureshadow

用分类汇总就可以了，不管是固定的行还是不固定的行。