将一行中户主后家庭成员依次与户主排在一列

yyzzggap

附件工作簿2中将一行中户主后家庭成员及身份证号码分别排列到每户户主C列与身份证号D列两列。数据量大，有没有什么公式可以解决。

deadzlq

PQ参考解法

abc123281

路过而已   无需搞那么复杂

Sub test()
Dim arr, brr(1 To 10000, 1 To 7)
With Sheets("Sheet1")
  arr = .[a1].CurrentRegion.Value
  For i = 2 To UBound(arr)
    m = m + 1
    For j = 1 To UBound(arr, 2) - 1
      If j > 7 Then
        If j Mod 2 = 0 Then
          If Len(arr(i, j)) > 0 Then
            m = m + 1
            brr(m, 3) = arr(i, j)
            brr(m, 4) = arr(i, j + 1)
          End If
        End If
      Else
        brr(m, j) = arr(i, j)
      End If
    Next
  Next
  .Range("a13").Resize(10000, 7).ClearContents
  .Range("a13").Resize(m, 6) = brr
End With
MsgBox "OK!", 64
End Sub

abc123281

工作簿123.rar (10.37 KB, 下载次数: 68)

2019-8-5 23:32 上传

点击文件名下载附件

yyzzggap

abc123281您好，我不懂VB，我使用你给我的VB程序，运行时显示下标错误“9”。我的数据c列（也就是户主姓名列）就有5915列，家庭成员最多有8人。还有就是“领取保障金额”列怎么不显示金额。

yyzzggap

abc123281 发表于 2019-8-5 23:32

abc123281您好，我不懂VB，我使用你给我的VB程序，运行时显示下标错误“9”。我的数据c列（也就是户主姓名列）就有5915列，家庭成员最多有8人。还有就是“领取保障金额”列怎么不显示金额。谢谢！

abc123281

你好  应该是有5915行吧   那肯定越界了
找到这个 Dim arr, brr(1 To 100000, 1 To 7)  更改一下
如果还有问题 qq联系 675762718

准提部林

Sub TEST()
Dim Arr, Brr, i&, j%, N&
Arr = Sheets("Sheet1").UsedRange
ReDim Brr(1 To 20000, 1 To 7)
For i = 2 To UBound(Arr)
    N = N + 1
    For j = 1 To 7: Brr(N, j) = Arr(i, j): Next
    For j = 8 To UBound(Arr, 2) Step 2
        If Arr(i, j) & Arr(i, j + 1) = "" Then GoTo 101
        N = N + 1: Brr(N, 3) = Arr(i, j): Brr(N, 4) = Arr(i, j + 1)
101: Next j
Next i
Sheets("Sheet2").UsedRange.Offset(1, 0).EntireRow.Delete
With [Sheet2!A2].Resize(N, 7)
      .Value = Brr
      .Borders.LineStyle = 1
      Application.Goto .Item(1)
End With
End Sub

Xl0000626.rar (10.33 KB, 下载次数: 56)

2019-8-6 11:54 上传

点击文件名下载附件

======================

abc123281

“领取保障金额”列怎么不显示金额的原因  小小失误

.Range("a13").Resize(m, 6) = brr  更改为  .Range("a13").Resize(m, 7) = brr

abc123281

数组重新组合123.rar (10.25 KB, 下载次数: 77)

2019-8-6 12:08 上传

点击文件名下载附件