|
具体见附件了。有兴趣的可以练下。
|
支持一下龙神
-----------------我是分隔线---------
方法1：
Sub test() '随心
Dim brr()
arr = Range('a2:c' & Cells(Rows.Count, 1).End(xlUp).Row)
For i = 1 To UBound(arr)
For j = 1 To arr(i, 3)
n = n 1
ReDim Preserve brr(1 To 3, 1 To n)
brr(1, n) = arr(i, 1)
brr(2, n) = arr(i, 2)
brr(3, n) = 1
Next
Next
Sheets('sheet2').[a1].Resize(UBound(brr, 2), UBound(brr)) = Application.Transpose(brr)
End Sub
-----------------我是分隔线---------
方法2：
长老：
Sub lzl()
Dim arr, t1, t2, i, j
Dim brr()
arr = Sheets('sheet1').Range('a2:c' & Sheets('sheet1').Cells(Rows.Count, 1).End(3).Row)
For i = 1 To UBound(arr)
t1 = t2 1
t2 = t1 arr(i, 3) - 1
ReDim Preserve brr(1 To 3, 1 To t2)
For j = t1 To t2
brr(1, j) = arr(i, 1)
brr(2, j) = arr(i, 2)
brr(3, j) = 1
Next
Next
Sheets('sheet2').Range('a1:c1') = Array('产品编号', '名称', '数量')
Sheets('sheet2').Range('a2').Resize(t2, 3) = Application.Transpose(brr)
End Sub
-----------------我是分隔线---------
方法3：
小子大神的python:
import xlrd
import xlwt
rw = 0
wb = xlrd.open_workbook(r'E:\cfsz.xlsx')
sh = wb.sheet_by_name('Sheet1')
f = xlwt.Workbook()
st = f.add_sheet(r'sheet1',cell_overwrite_ok=True)
st.write(0,0,sh.cell(0,0).value)
st.write(0,1,sh.cell(0,1).value)
st.write(0,2,sh.cell(0,2).value)
for i in range(1,sh.nrows):
x = int(sh.cell(i,2).value)
for t in range(0,x):
rw = 1
st.write(rw,0,sh.cell(i,0).value)
st.write(rw,1,sh.cell(i,1).value)
st.write(rw,2,1)
f.save(r'E:\sjcfl.xls')
-----------------我是分隔线---------
方法4：
春心的洪荒之力：
Sub Greenhand()
Dim arr, brr(1 To 100000, 1 To 3), i&, k&
With Sheet2
.Cells.Clear
.Columns('a:b').NumberFormat = '@'
.Range('a1:c1') = Array('产品编号', '名称', '数量')
End With
arr = Sheet1.Range('a2', Sheet1.Cells(2, 3).End(4))
For i = 1 To UBound(arr)
For j = 1 To arr(i, 3)
k = k 1
brr(k, 1) = arr(i, 1)
brr(k, 2) = arr(i, 2)
brr(k, 3) = 1
Next
Next
Sheet2.[a2].Resize(k, 3) = brr
End Sub
-----------------我是分隔线---------
方法5：
龙神自己的：
Sub split_num()
Dim raw, i As Long, j As Long, cnt As Long
With Sheets('Sheet1')
'将数据源存入raw数组
raw = .Range('A1').CurrentRegion.Value
'定义结果数组大小。根据拆分特点，数组第一维ubound为第三列求和 1（列标题）
ReDim result(1 To Application.Sum(.Columns(3)) 1, 1 To UBound(raw, 2))
End With
For i = 1 To UBound(raw)
If i > 1 Then
'根据raw(i,3)拆分各行
For j = 1 To raw(i, 3)
cnt = cnt 1
result(cnt, 1) = raw(i, 1)
result(cnt, 2) = raw(i, 2)
result(cnt, 3) = 1
Next
Else
'列标题写入
For j = 1 To UBound(raw, 2)
cnt = 1
result(cnt, j) = raw(i, j)
Next
End If
Next
'写入单元格
Application.ScreenUpdating = False
With Sheets('Sheet2')
.Cells.Clear
.Range('A1').Resize(UBound(result), UBound(result, 2)) = result
' With .Range('A1').CurrentRegion
' .Font.Name = '微软雅黑'
' .Font.Size = 9
' .Borders.LineStyle = 1
' End With
End With
Application.ScreenUpdating = True
End Sub
-----------------我是分隔线---------
方法6：
七七的PQ：
let
S1 = Excel.CurrentWorkbook(){[Name='Data']}[Content],
S2 = Table.AddColumn(S1, 'List', each List.Transform({1..[数量]},(_)=>_/_)),
S3 = Table.ExpandListColumn(S2, 'List'),
S4 = Table.RemoveColumns(S3,{'数量'}),
S5 = Table.RenameColumns(S4,{{'List', '数量'}})
in
S5
-----------------我是分隔线---------
方法7：
诗人的：
Sub cdsr()
Dim arr, i&, k&, m&, brr(1 To 100000, 1 To 3)
arr = Sheet1.[a1].CurrentRegion
brr(1, 1) = '产品编号': brr(1, 2) = '名称': brr(1, 3) = '数量'
k = 1
For i = 2 To UBound(arr)
For m = 1 To arr(i, 3)
k = k 1
brr(k, 1) = Str(arr(i, 1))
brr(k, 2) = arr(i, 2)
brr(k, 3) = 1
Next
Next
Sheet2.Cells.ClearContents
Sheet2.[a1].Resize(k, 3) = brr
End Sub
-----------------我是分隔线---------
方法8：
bajifeng的：
Sub b() 'bajifeng
Dim br(), ar, i&, j%, u&
ar = [a1].CurrentRegion
For i = 2 To UBound(ar)
If i = 2 Then u = 0 Else u = UBound(br)
ReDim Preserve br(1 To 3, 1 To u ar(i, 3))
For j = 1 To ar(i, 3)
br(1, u j) = ''' & ar(i, 1)
br(2, u j) = ar(i, 2)
br(3, u j) = 1
Next
Next
Sheets(2).[a2].Resize([a65536].End(3).Row, 3).Clear
Sheets(2).[a2].Resize(UBound(br, 2), 3) = Application.Transpose(br)
End Sub
-----------------我是分隔线---------
方法9：
随心的python:
import pandas as pd
import csv
data=pd.read_excel('e:\\test\\拆分数字.xlsx')
data1=data[['产品编号','名称','数量']]
tuple_1=()
list_1=[]
for line in data1.index:
time=data1.loc[line,'数量']
for i in range(1,int(time) 1):
tuple_1=(data1.loc[line,'产品编号'],data1.loc[line,'名称'],1)
list_1.append(tuple_1)
with open('E:\\test\\拆分数字.csv','w', newline='') as datacsv:
csvwriter = csv.writer(datacsv,dialect=('excel'))
csvwriter.writerow(['产品编号','名称','数量'])
csvwriter.writerows(list_1)
-----------------我是分隔线---------
方法10：
梁总的：
Sub text()
Dim arr, brr, item As Long, crr(), i As Long, j As Long, k As Long
Dim tim1 As Date, tim2 As Date: tim1 = Timer
Application.ScreenUpdating = False
With Worksheets('Sheet1')
arr = .Range('a2:c' & .Cells(.Rows.Count, 3).End(xlUp).Row)
brr = .Range('c2:c' & .Cells(.Rows.Count, 3).End(xlUp).Row)
End With
item = WorksheetFunction.Sum(brr)
If item > Rows.Count Then Exit Sub
ReDim crr(1 To item, 1 To 3)
For i = 1 To UBound(brr)
For j = 1 To brr(i, 1)
k = k 1
crr(k, 1) = arr(i, 1)
crr(k, 2) = arr(i, 2)
crr(k, 3) = 1
Next
Next
With Worksheets('Sheet3')
.Range('A1:C1') = Array('产品编号', '名称', '数量')
.Range('A2').Resize(item, 3) = crr
End With
Application.ScreenUpdating = True
tim2 = Timer
MsgBox Format(tim2 - tim1, '程序执行时间为：0.00秒'), 64, '时间统计'
End Sub
原贴链接：http://www./bbs/forum.php?mod=viewthread&tid=444
|
