在线等，求助大神，感谢！

ˇ曜ˇ

准提部林

每戶最少要4行(含戶主)????

ˇ曜ˇ

准提部林 发表于 2022-12-3 12:00
每戶最少要4行(含戶主)????

不用，每户有几人留几行就行。

ˇ曜ˇ

准提部林 发表于 2022-12-3 12:00
每戶最少要4行(含戶主)????

非常感谢大神。

smsn

以前见过，数据再多给一些吧，改掉个人信息，假的不要紧，

fzxba

1. Sub Dec3rd()
   
2.   Dim ar, br() As String
   
3.   Dim i As Integer, j As Integer, k As Integer
   
4.   ar = Range("S1", Cells(Rows.Count, "P").End(xlUp))
   
5.   ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
   
6.   br(1, 3) = ar(1, 1)
   
7.   br(1, 4) = ar(1, 4)
   
8.   For i = 2 To UBound(ar)
   
9.     If ar(i, 2) = "户主" Then j = 1 Else If j = 1 Then br(i, 1) = "与户主关系": j = 2
   
10.     br(i, j) = ar(i, 2)
    
11.     br(i, 3) = ar(i, 1)
    
12.     br(i, 4) = ar(i, 4)
    
13.   Next
    
14.   With Range("D1")
    
15.     .CurrentRegion.Clear
    
16.     With .Resize(UBound(br), UBound(br, 2))
    
17.       .Value = br
    
18.       .Borders.LineStyle = xlContinuous
    
19.       .HorizontalAlignment = xlCenter
    
20.     End With
    
21.     For i = UBound(br) To 2 Step -1
    
22.       k = k + 1
    
23.       If br(i, 1) = "户主" Then
    
24.         k = k - 1
    
25.         If k > 1 Then .Offset(i).Resize(k).Merge
    
26.         .Offset(i - 1).Resize(, 2).HorizontalAlignment = 7
    
27.         k = 0
    
28.       End If
    
29.     Next
    
30.   End With
    
31.   Beep
    
32. End Sub

复制代码

fzxba

样表.rar (19.15 KB, 下载次数: 7)

2022-12-3 17:59 上传

点击文件名下载附件

另附： 样表据后面描述更改.rar (22.26 KB, 下载次数: 3)

2022-12-4 15:27 上传

点击文件名下载附件

准提部林

樣本資料有點怪//亂做個
Xl0000281.rar (15.65 KB, 下载次数: 6)

2022-12-3 18:02 上传

点击文件名下载附件

iu950

附件内容供参考......

smsn

楼主，你确定他们是夫妻吗？
住址不一样哦。

你的数据源，
应该要要按照地址分开，且相同的地址 可能有多个户主，多个妻子（2个户主各自的妻子，不是大小老婆）



最好在多点数据。