二维转一位这个不会了请大神们帮忙写一下

克里斯苏

这个该咋写呢大神们！

半百

大概的意思
Sub test()
Dim brr(1 To 9999, 1 To 5)
arr = [b2:f100]
For i = 2 To UBound(arr)
    If arr(i, 1) <> "" Then
        For j = 3 To 5
            If arr(i, j) <> "" Then
                n = n + 1
                brr(n, 1) = arr(i, 1)
                brr(n, 2) = arr(i, 2)
                brr(n, 3) = arr(i, j)
            End If
        Next
    End If
Next
[h3].Resize(n, 5) = brr
End Sub

半百

半百

excel玉米

没有附件，只有凭空想象，错了别见怪。
Sub Test()
Dim Arr,Brr(),i％,j％,k％
Arr=Sheet1.Usedrange.  '将源数据装入数组
For i=Lbound(Arr) to Ubound(Arr)
    For j=3 to 5
          If Len(Arr(i,j))＞0 Then
              k=k+1
             Redim preserve Brr(1 To 3,1 To k)
             Brr(1,k)=Arr(i,1)
             Brr(2,k)=Arr(i,2)
             Brr(3,k)=Arr(i,j)
          End If
    Next j
Next i
With Sheet2
       .cells(1,1)=”单号"
       .cells(1,2)="车辆"
       .cells(1,3)="货品"
        .cells(2,1),Resize(Ubound(Brr,2),Ubound(Brr))=Application.Transpose(Brr)
End With
End Sub

taller

x-xx-xx

https://club.excelhome.net/forum.php?mod=viewthread&tid=1625885&extra=&mobile=2
2楼

cyq4896

模拟一下.....

沈默00

菜鸟练个手
Sub test()
    Dim arr, brr, i%, j%, n%
    arr = Sheet1.Range("a1", Cells(Rows.Count, "e").End(xlUp))
    ReDim brr(1 To 100, 1 To 3)
    For i = 2 To UBound(arr)
        For j = 3 To UBound(arr, 2)
            If arr(i, j) <> "" Then
            n = n + 1
                brr(n, 1) = "'" & arr(i, 1)
                brr(n, 2) = arr(i, 2)
                brr(n, 3) = arr(i, j)
            End If
        Next j
    Next i
With Sheet1
.[k2].CurrentRegion.ClearContents
.Cells(1, "k") = .[a1]: .Cells(1, "l") = .[b1]: .Cells(1, "m") = "货品"
.[k2].Resize(UBound(brr), UBound(brr, 2)) = brr
End With
End Sub

cidanji

练手

1. Sub ss()
   
2.     Dim arr(), brr(), i&, d&, dd&
   
3.     arr = Range("A1:E" & Cells(Rows.Count, 1).End(3).Row)
   
4.     ReDim brr(1 To UBound(arr) * 3, 1 To 3)
   
5.     For i = 2 To UBound(arr)
   
6.         If Len(arr(i, 1)) > 0 Then
   
7.             For dd = 3 To 5
   
8.                 If Len(arr(i, dd)) > 0 Then
   
9.                     d = d + 1
   
10.                     brr(d, 1) = arr(i, 1): brr(d, 2) = arr(i, 2)
    
11.                     brr(d, 3) = arr(i, dd)
    
12.                 End If
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     Range("G1:I1") = Array("单号", "车辆", "货品")
    
17.     Range("G2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
18. End Sub

复制代码