[已解决]提取数据

a316667229

A1为数据表格A1：A4结合数据，B1为数据A5以此类推，如何用VBA实现，因为数据太大，用函数太卡了 1.rar (8.66 KB, 下载次数: 7)

2017-9-18 13:59 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-9-18 14:09

1. Sub aaa()
   
2. Dim arr, brr, i&, j&, k&, s$
   
3. arr = Sheets(1).[a1].CurrentRegion
   
4. ReDim brr(1 To UBound(arr) - 4, 1 To UBound(arr, 2) * 2)
   
5. For j = 1 To UBound(arr, 2)
   
6.   For i = 1 To UBound(arr) - 4
   
7.     For k = i To i + 3
   
8.       s = s & arr(k, j)
   
9.     Next k
   
10.     brr(i, (j - 1) * 2 + 1) = s
    
11.     brr(i, (j - 1) * 2 + 2) = arr(i + 4, j)
    
12.     s = ""
    
13.   Next i
    
14. Next j
    
15. Sheets(2).[a1].Resize(UBound(brr), UBound(brr, 2)) = brr
    
16. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, i&, j&, k&, s$
   
3. arr = Sheets(1).[a1].CurrentRegion
   
4. ReDim brr(1 To UBound(arr) - 4, 1 To UBound(arr, 2) * 2)
   
5. For j = 1 To UBound(arr, 2)
   
6.   For i = 1 To UBound(arr) - 4
   
7.     For k = i To i + 3
   
8.       s = s & arr(k, j)
   
9.     Next k
   
10.     brr(i, (j - 1) * 2 + 1) = s
    
11.     brr(i, (j - 1) * 2 + 2) = arr(i + 4, j)
    
12.     s = ""
    
13.   Next i
    
14. Next j
    
15. Sheets(2).[a1].Resize(UBound(brr), UBound(brr, 2)) = brr
    
16. End Sub

复制代码

a316667229

大灰狼1976 发表于 2017-9-18 14:09

遇到前面是0就变成这样了

大灰狼1976

这个不用VBA处理的，只要把SHEET2单元格格式改成文本格式再运行就行了。

a316667229

大灰狼1976 发表于 2017-9-18 14:21
这个不用VBA处理的，只要把SHEET2单元格格式改成文本格式再运行就行了。

啊，那样太麻烦了，每次都要复制数据，数据表格是所以数据是网页提取过来了，经常会更新的

a316667229

a316667229 发表于 2017-9-18 14:34
啊，那样太麻烦了，每次都要复制数据，数据表格是所以数据是网页提取过来了，经常会更新的

我知道你的意思了

a316667229

大灰狼1976 发表于 2017-9-18 14:21
这个不用VBA处理的，只要把SHEET2单元格格式改成文本格式再运行就行了。

你好，大师，我想请问一下，如何运用VBA实现一个表格里面所以的VBA每隔一个时间里面自动运行一次，比如说我设置一个60秒就循环更新一下，

大灰狼1976

实在不想设置单元格格式的话，就把：
brr(i, (j - 1) * 2 + 1) = s
改成
brr(i, (j - 1) * 2 + 1) ="'" & s

a316667229

大灰狼1976 发表于 2017-9-18 14:38
实在不想设置单元格格式的话，就把：
brr(i, (j - 1) * 2 + 1) = s
改成

如果我要从数据表格B4开始要如何更改呢

a316667229

a316667229 发表于 2017-9-18 15:07
如果我要从数据表格B4开始要如何更改呢