[已解决]请教数组提取问题

hwc2ycy

==，这个也不难的。

hwc2ycy

你把两个代码都整到要改的数据里，再发上来，我改下。
电脑上没有现成的。

yizhih

hwc2ycy 发表于 2013-1-29 14:04
你把两个代码都整到要改的数据里，再发上来，我改下。
电脑上没有现成的。

万分感谢 hwc2ycy 老师。
将提取1和提取2放到了一个压缩包内了。
提取1和提取2.rar (134.79 KB, 下载次数: 4)

2013-1-29 17:45 上传

点击文件名下载附件

hwc2ycy

我跟你提个建议啊，听不听，接受不接受是你的事。

我不知道你是做什么职业的，这数据是从何而来的。如果是手工输入的，千万不要整这种数据，后期处理会不知会带来多少麻烦。如果需要数字前不足位的显示0，你可以用自定义格式。
这种前面加0的，后期如果要用代码处理，再想保留0再写回到单元格，就要多很多操作。其实这个0只有显示的作用，计算毫无意义 。

yizhih

hwc2ycy 发表于 2013-1-29 18:45
我跟你提个建议啊，听不听，接受不接受是你的事。

我不知道你是做什么职业的，这数据是从何而来的。如果 ...

前面加0只是好看，没有实际意义，今后不加了。

hwc2ycy

1. Sub 提取1()
   
2. '---------------------------------------------------------------------------------------
   
3. ' Procedure : 提取1
   
4. ' Author    : hwc2ycy
   
5. ' Date      : 2013/1/29
   
6. ' Purpose   :所有数据再分列
   
7. '---------------------------------------------------------------------------------------
   
8. '
   
9.     Dim ShtArr, arr(1 To 6, 1 To 1)
   
10.     Dim iRow&, i&, j&, k&, iRow2&, iCol&
    
11.     Dim shtMerge1$, DestShtArr
    
12.     Dim shtPos&
    
13.     shtMerge1 = "合并"
    
14.     ShtArr = Array("主表格", "主表格1", "主表格2", "主表格3", "主表格4", "主表格5")
    
15.     DestShtArr = Array("合并", "合并1", "合并2", "合并3", "合并4")
    
16.     Application.ScreenUpdating = False
    
17. 
    
18.     With Worksheets(ShtArr(0))
    
19.         iRow = .Cells(Rows.Count, "au").End(xlUp).Row
    
20.         iCol = .Cells(16, Columns.Count).End(xlToLeft).Column
    
21.     End With
    
22. 
    
23.     For k = 47 To 55 Step 2
    
24.         Worksheets(DestShtArr(shtPos)).Columns("j").Clear
    
25.         For i = 16 To iRow
    
26.             Erase arr
    
27.             For j = 0 To UBound(ShtArr)
    
28.                 arr(j + 1, 1) = Worksheets(ShtArr(j)).Cells(i, k)
    
29.                 If Len(arr(j + 1, 1)) = 0 Then arr(j + 1, 1) = " "
    
30.             Next j
    
31. 
    
32.             With Worksheets(DestShtArr(shtPos))
    
33.                 iRow2 = .Cells(Rows.Count, "j").End(xlUp).Row + 1
    
34.                 If iRow2 < 6 Then iRow2 = 6
    
35.                 '.Cells(iRow2, "j").Resize(6) = arr
    
36.                 For Each arritem In arr
    
37.                     If Len(arritem) Then
    
38.                         arrtemp = Split(arritem, " ")
    
39.                         .Cells(iRow2, "j").Resize(, UBound(arrtemp) + 1) = arrtemp
    
40.                     Else
    
41.                         .Cells(iRow2, "j") = arritem
    
42.                     End If
    
43.                     iRow2 = iRow2 + 1
    
44.                 Next
    
45.                 .Columns("j").AutoFit
    
46.                 .Columns("j").HorizontalAlignment = xlLeft
    
47.             End With
    
48.         Next i
    
49.         shtPos = shtPos + 1
    
50.     Next k
    
51.     Application.ScreenUpdating = True
    
52.     MsgBox "提取完成"
    
53. End Sub

复制代码

hwc2ycy

提取2好像不需要分列吧。

yizhih

hwc2ycy 发表于 2013-1-29 22:18
提取2好像不需要分列吧。

提取2不需要分列

提取1测试发现：“合并”、“合并1”正确，但是：“合并2”、“合并3”、“合并4”提取的不正确，我把不正确的地方标注了出来。
旁边是手工正确的提取。
谢谢hwc2ycy老师。辛苦了。
提取1.rar (214.03 KB, 下载次数: 1)

2013-1-29 22:55 上传

点击文件名下载附件

hwc2ycy

应该是数值的问题，一样的算法。
明天帮你看吧。

yizhih

hwc2ycy 发表于 2013-1-29 23:01
应该是数值的问题，一样的算法。
明天帮你看吧。

           谢谢！