Sub test()
Dim arr2() As Variant
Rows("14:20").Clear
arr1 = Range("B6:D" & Cells(Rows.Count, 2).End(xlUp).Row).Value
For myr = 1 To UBound(arr1, 1)
If arr1(myr, 3) <> "" Then
xz = Split(arr1(myr, 3), "、")
For myc = 0 To UBound(xz)
ReDim Preserve arr2(1 To 3, a)
arr2(1, a) = arr1(myr, 1)
arr2(2, a) = arr1(myr, 2)
arr2(3, a) = xz(myc)
a = a + 1
Next myc
End If
Next myr
Range("B14").Resize(a, 3) = Application.Transpose(arr2)
End Sub
|
Access软件网交流QQ群(群号：198465573) |
|
