大神帮忙看看怎么把附件一行多列记录转化成多行

bijingwei520

大神帮忙看看怎么把附件一行多列记录转化成多行，具体见附件，万分感谢！！！！

CC例例

批次列数固定4列吗？

bijingwei520

CC例例 发表于 2018-7-19 14:42
批次列数固定4列吗？

不固定，但最多4列，像附件一样

jiangxiaoyun

Sub vf()
    Dim arr, brr(1 To 66666, 1 To 7), i&
    With Sheet1
        r = .Cells(Rows.Count, 2).End(xlUp).Row
        arr = .Range("b2:o" & r).Value
    End With
    For i = 1 To UBound(arr)
        For j = 4 To 10 Step 2
            If arr(i, j) <> "" Then
                k = k + 1
                brr(k, 1) = Date: brr(k, 2) = arr(i, 2): brr(k, 3) = arr(i, 3)
                brr(k, 4) = arr(i, 14): brr(k, 5) = arr(i, 1)
                brr(k, 6) = arr(i, j): brr(k, 7) = arr(i, j + 1)
            End If
        Next
    Next
    Sheet2.[a2:g66666] = ""
    Sheet2.[a2].Resize(k, 7) = brr
End Sub

杨宝明

代码

1. Sub zz()
   
2. Dim r, ar1, n, i, j
   
3. Sheets("测试").[a2:g1000] = ""
   
4. r = Sheets("sheet1").[b65223].End(xlUp).Row
   
5. ar1 = Sheets("Sheet1").Range("e2:l" & r)
   
6. n = 1
   
7. For i = 1 To UBound(ar1)
   
8.     For j = 1 To UBound(ar1, 2) - 1 Step 2
   
9.         If ar1(i, j) <> "" Then
   
10.             n = n + 1
    
11.             With Sheets("测试")
    
12.                 .Cells(n, 1) = Format(Date, "yyyy/m/d")
    
13.                 .Cells(n, 2) = Sheets("Sheet1").Cells(i + 1, 3).Value
    
14.                 .Cells(n, 3) = Sheets("Sheet1").Cells(i + 1, 4).Value
    
15.                 .Cells(n, 4) = Sheets("Sheet1").Range("o" & i + 1).Value
    
16.                 .Cells(n, 5) = Sheets("Sheet1").Cells(i + 1, 2).Value
    
17.                 .Cells(n, 6) = ar1(i, j)
    
18.                 .Cells(n, 7) = ar1(i, j + 1)
    
19.             End With
    
20.         End If
    
21.     Next
    
22. Next
    
23. End Sub
    
24. 
    

复制代码