[已解决]请高手帮帮忙，设计一个代码实现：根据区域（B4:S11）的数据.......，谢谢了！

lbhlbh

请高手帮帮忙，设计一个代码实现：根据区域（B4:S11）的数据，（该区域的数据是不规则的，有时每一行可能全有数据，有时只有一个代码、品种和数量，有时会有2个以上，但最多只有四个（如表1中的第五行））。1、如果第四行有三个品种，依次将B4和H4:J4\B4和K4:M4\B4和N4:P4的数据自动填列到表1中的第一个空白行的C列和E\F\L列（如表1红色部份所示）。如果第五行有一个品种，那就依次将B5和H5:J5的数据自动填列到表1中的第一个空白行的C列和E\F\L列（如表1红色部份所示）。以此类推！效果如表1所示。详见附件！谢谢了！

最佳答案

月排行榜 / 总排行榜

grf1973

2016-4-21 11:41

1. Private Sub 录入数据保存_Click()
   
2.     arr = Sheets("2").Range("a4:s11")
   
3.     ReDim brr(1 To 4 * UBound(arr), 1 To 10)
   
4.     For i = 1 To UBound(arr)
   
5.         For j = 9 To UBound(arr, 2) Step 3
   
6.             If arr(i, j) <> "" Then
   
7.                 n = n + 1
   
8.                 brr(n, 1) = arr(i, 2)
   
9.                 brr(n, 3) = arr(i, j - 1)
   
10.                 brr(n, 4) = arr(i, j)
    
11.                 brr(n, 10) = arr(i, j + 1)
    
12.             End If
    
13.         Next
    
14.     Next
    
15.     With Sheets("1")
    
16.         r = .[c65536].End(3).Row + 1
    
17.         .Cells(r, 3).Resize(n, 10) = brr
    
18.         .Activate
    
19.     End With
    
20. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Private Sub 录入数据保存_Click()
   
2.     arr = Sheets("2").Range("a4:s11")
   
3.     ReDim brr(1 To 4 * UBound(arr), 1 To 10)
   
4.     For i = 1 To UBound(arr)
   
5.         For j = 9 To UBound(arr, 2) Step 3
   
6.             If arr(i, j) <> "" Then
   
7.                 n = n + 1
   
8.                 brr(n, 1) = arr(i, 2)
   
9.                 brr(n, 3) = arr(i, j - 1)
   
10.                 brr(n, 4) = arr(i, j)
    
11.                 brr(n, 10) = arr(i, j + 1)
    
12.             End If
    
13.         Next
    
14.     Next
    
15.     With Sheets("1")
    
16.         r = .[c65536].End(3).Row + 1
    
17.         .Cells(r, 3).Resize(n, 10) = brr
    
18.         .Activate
    
19.     End With
    
20. End Sub
    

复制代码

lbhlbh

grf1973 发表于 2016-4-21 11:41

谢谢您的帮忙，真的不错，谢谢了