请见Sheet2
代码中的"户主"若变乱码,请自行修改
Sub test()
Dim r%, n%, c As Range, Sh As Worksheet
Set Sh = Sheets("Sheet2")
r = Sh.[A65536].End(xlUp).Row
With Sh.Range("A1:A" & r)
Set c = .Find("户主", , , 1) '查找字符串"户主"
If Not c Is Nothing Then
fAdd = c.Address
n = c.Row '字符串"户主"所在列号
Do
If c.Row > n Then
If c.Row - n < 8 Then Sh.Rows(c.Row).Resize(8 - (c.Row - n)).Insert Shift:=xlDown '每户不滿8列,插入空白列
Application.CutCopyMode = False
Sh.Range("A1:Q6").Copy '复制表头
Sh.Rows(c.Row).Insert Shift:=xlDown '插入表头
n = c.Row
End If
Set c = .FindNext(c) '查找下个字符串"户主"所在列
Loop While Not c Is Nothing And c.Address <> fAdd
End If
Application.CutCopyMode = True
Sh.Range(Sh.Cells(n, 1), Sh.Cells(n + 7, 17)).Borders.LineStyle = 1 '最后一户不滿8列,画8列表格线
End With
End Sub
2010-7-1 08:49 上传
点击文件名下载附件
11.12 KB, 下载次数: 77