将【乱序列】捋顺，变成规范列的内容

于恒

如图如附件，求vba代码

前提是，身份证号都是标准的：18位的，
手机号都是11位的，
情况都是“拒绝”，

希望遍历，因为有很多行，例子仅以3行为例。

半百

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.7.29
   
2.     With Sheets("Sheet1")
   
3.         r = .Cells(Rows.Count, 1).End(3).Row
   
4.         arr = .[a2].Resize(r - 1, 6)
   
5.     End With
   
6.     ReDim brr(1 To UBound(arr), 1 To 6)
   
7.     For i = 1 To UBound(arr)
   
8.         m = m + 1
   
9.         brr(m, 1) = arr(i, 1)
   
10.         brr(m, 2) = arr(i, 2)
    
11.         brr(m, 6) = arr(i, 6)
    
12.         For j = 3 To 5
    
13.             If arr(i, j) = "拒绝" Then brr(m, 3) = arr(i, j)
    
14.             If Len(arr(i, j)) = 18 Then brr(m, 4) = arr(i, j)
    
15.             If Len(arr(i, j)) = 11 Then brr(m, 5) = arr(i, j)
    
16.         Next
    
17.     Next
    
18.     With Sheets("Sheet2")
    
19.         .UsedRange.Offset(1).Clear
    
20.         .Columns("D:E").NumberFormatLocal = "@"
    
21.         With .[a2].Resize(m, 6)
    
22.             .Value = brr
    
23.             .Borders.LineStyle = 1
    
24.             .HorizontalAlignment = xlCenter
    
25.             .VerticalAlignment = xlCenter
    
26.         End With
    
27.     End With
    
28.     MsgBox "OK！"
    
29. End Sub
    

复制代码