[已解决]修改代码在行空白单元格里添加数字

ymq123 · 发表于 2013-12-7 00:30

本帖最后由 ymq123 于 2013-12-7 13:35 编辑

1、表1、表2中每行有7个数字，还有3个空格，分别在每行空格里添加上该空格对应的1个数字，使每行变为8个数字.，把表1数字添加后放到表3里、把表2数字添加后放到表4里。
2、如下表：表1第一行里空格对应的数字是1、9、10，表2第一行里空格对应的数字是1、4、9.有颜色单元格是空格，红字是对应单元格的数字。

表1											表2
1	2	3	4	5	6	7	8	9	10		1	2	3	4	5	6	7	8	9	10

3、数字添加后如表3和表4，两表黑斜体字是在每行第一个空格添加数字、红色字是在每行第二个空格里添加数字、粗黑体字是在每行第三个空格里添加数字。

我编写的代码太慢，请您修改。谢谢

最佳答案

月排行榜 / 总排行榜

轩辕轼轲

2013-12-7 12:37

Option Base 1
Function 组合数据(sRng As Range, tRng As Range)
Dim x%, y%, i%, m%, n%
Dim sArr(), tArr()
sArr = sRng
For y = 1 To 3
For x = 1 To UBound(sArr, 1)
For m = y To y + 7
If sArr(x, m) = "" Then
n = n + 1
ReDim Preserve tArr(1 To 10, 1 To n)
For i = 1 To 10
If i = m Then tArr(i, n) = m Else tArr(i, n) = sArr(x, i)
Next i
Exit For
End If
Next m
Next x
Next y
tRng.Resize(n, 10) = Application.Transpose(tArr)
'sRng.Copy
'tRng.Resize(n, 10).PasteSpecial Paste:=xlPasteFormats
End Function
Sub 生成数据()
tms = Timer
Range("Y2:AS6000").Clear
组合数据 Range(Cells(2, 1), Cells(17, 10)), Range("Y2")
组合数据 Range(Cells(2, 12), Cells(17, 21)), Range("AJ2")
MsgBox Format(Timer - tms, "0.000s ")
End Sub

复制代码

我电脑上0.066秒

跳转到最佳答案楼层

hwc2ycy · 发表于 2013-12-7 09:42

非要保留格式么？

hwc2ycy · 发表于 2013-12-7 10:02

其实用数组直接就行了，数据不多，这个速度要求意义不大。

ymq123 · 发表于 2013-12-7 11:19

hwc2ycy 发表于 2013-12-7 10:02
其实用数组直接就行了，数据不多，这个速度要求意义不大。

老师你好，不需要保留格式，数据很多，越快越好，请帮助修改。谢谢

hwc2ycy · 发表于 2013-12-7 11:31

ymq123 发表于 2013-12-7 11:19
老师你好，不需要保留格式，数据很多，越快越好，请帮助修改。谢谢

直接用数组取巧，1-10直接填。
如果你要设置填入了数字的单元格的格式，那就得多写点代码才成。

Sub test()
Dim arr1, arr2
arr1 = Range("a2:j17").Value
Dim i As Byte, j As Byte
For i = LBound(arr1) To UBound(arr1)
For j = LBound(arr1, 2) To UBound(arr1, 2)
arr1(i, j) = j
Next
Next
Range("y2").Resize(UBound(arr1), UBound(arr1, 2)).Value = arr1
Range("aj2").Resize(UBound(arr1), UBound(arr1, 2)).Value = arr1
End Sub

复制代码

ymq123 · 发表于 2013-12-7 12:09

hwc2ycy 发表于 2013-12-7 11:31
直接用数组取巧，1-10直接填。
如果你要设置填入了数字的单元格的格式，那就得多写点代码才成。

老师你好：1、每行只添加一个数字，添加后每行只是8个数字,附件表3和表4是添加后结果，每行三个空格用不同的颜色标出来了
2、表1数字添加后结果在表3、表2添加后结果在表4
谢谢！

轩辕轼轲 · 发表于 2013-12-7 12:37

Option Base 1
Function 组合数据(sRng As Range, tRng As Range)
Dim x%, y%, i%, m%, n%
Dim sArr(), tArr()
sArr = sRng
For y = 1 To 3
For x = 1 To UBound(sArr, 1)
For m = y To y + 7
If sArr(x, m) = "" Then
n = n + 1
ReDim Preserve tArr(1 To 10, 1 To n)
For i = 1 To 10
If i = m Then tArr(i, n) = m Else tArr(i, n) = sArr(x, i)
Next i
Exit For
End If
Next m
Next x
Next y
tRng.Resize(n, 10) = Application.Transpose(tArr)
'sRng.Copy
'tRng.Resize(n, 10).PasteSpecial Paste:=xlPasteFormats
End Function
Sub 生成数据()
tms = Timer
Range("Y2:AS6000").Clear
组合数据 Range(Cells(2, 1), Cells(17, 10)), Range("Y2")
组合数据 Range(Cells(2, 12), Cells(17, 21)), Range("AJ2")
MsgBox Format(Timer - tms, "0.000s ")
End Sub

复制代码

我电脑上0.066秒

ymq123 · 发表于 2013-12-7 13:34

轩辕轼轲发表于 2013-12-7 12:37
我电脑上0.066秒

请教下面两个问题：
1、Option Base 1 有什么作用？
2、在[模块1（代码）]与在[sheet1（代码）]中编代码有什么区别吗？
谢谢

ymq123 · 发表于 2013-12-7 13:40

ymq123 发表于 2013-12-7 13:34
请教下面两个问题：
1、Option Base 1 有什么作用？
2、在[模块1（代码）]与在[sheet1（代码）]中编代 ...

还有个问题需请教：
sArr = sRng 有什么作用？
谢谢！

轩辕轼轲 · 发表于 2013-12-9 09:08

ymq123 发表于 2013-12-7 13:34
请教下面两个问题：
1、Option Base 1 有什么作用？
2、在[模块1（代码）]与在[sheet1（代码）]中编代 ...

1、VBE里面默认数组下标是从0开始的，Option Base 1的作用是强制数组下标从1开始；
2、代码放在sheet1里面也可以，没什么区别，我比较习惯放在标准模块里面。

		自动登录	找回密码
密码			注册

[已解决]修改代码在行空白单元格里添加数字

评分

点评

浏览过的版块

[已解决]修改代码 在行空白单元格里添加数字

评分

点评

浏览过的版块

[已解决]修改代码在行空白单元格里添加数字