设为首页收藏本站

开启辅助访问

Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 横列转成竖列数据格式,麻烦高手帮助改下附件的代码..

数据透视表40+个常用小技巧，让你一次学会！

发新帖

查看: 1936|回复: 4

[已解决]横列转成竖列数据格式,麻烦高手帮助改下附件的代码..

发表于 2016-8-19 23:48 | 显示全部楼层 |阅读模式

工作中常用的Excel函数公式，全印在一张超大鼠标垫上

本帖最后由 dehaijun2 于 2016-8-19 23:49 编辑

横列转成竖列数据格式,麻烦高手帮助改下附件的代码..
附件在2楼

最佳答案

月排行榜 / 总排行榜

雪舞子

2016-8-20 06:24

Sub test()
Dim arr, brr(1 To 10000, 1 To 6), i&, j%, k%, n&, m#
arr = Range("a4").CurrentRegion
For i = 4 To UBound(arr)
If arr(i, UBound(arr, 2)) = "OK" Then
For j = 8 To UBound(arr, 2) - 1 Step 2
If arr(i, j + 1) > 0 Then
n = n + 1
For k = 1 To 3
brr(n, k) = arr(i, k)
Next
brr(n, 4) = arr(i, j)
brr(n, 5) = arr(i, 5)
brr(n, 6) = arr(i, j + 1)
m = m + arr(i, j + 1)
End If
Next
End If
Next
n = n + 2
brr(n, 1) = "合计：": brr(n, 6) = m
[a4003:f65536] = ""
[a4003].Resize(n, 6) = brr
End Sub

复制代码

11.rar (35.79 KB, 下载次数: 5)

excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程

回复

使用道具举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上

楼主| 发表于 2016-8-19 23:49 | 显示全部楼层

工作中常用的Excel函数公式，全印在一张超大鼠标垫上

11.rar (37.03 KB, 下载次数: 4)

回复

使用道具举报

发表于 2016-8-20 06:24 | 显示全部楼层本楼为最佳答案

工作中最常用的Excel函数公式，全印在一张鼠标垫上

这个最佳答案由雪舞子给出，感谢雪舞子的回答。

单击隐藏图章

Sub test()
Dim arr, brr(1 To 10000, 1 To 6), i&, j%, k%, n&, m#
arr = Range("a4").CurrentRegion
For i = 4 To UBound(arr)
If arr(i, UBound(arr, 2)) = "OK" Then
For j = 8 To UBound(arr, 2) - 1 Step 2
If arr(i, j + 1) > 0 Then
n = n + 1
For k = 1 To 3
brr(n, k) = arr(i, k)
Next
brr(n, 4) = arr(i, j)
brr(n, 5) = arr(i, 5)
brr(n, 6) = arr(i, j + 1)
m = m + arr(i, j + 1)
End If
Next
End If
Next
n = n + 2
brr(n, 1) = "合计：": brr(n, 6) = m
[a4003:f65536] = ""
[a4003].Resize(n, 6) = brr
End Sub

复制代码

11.rar (35.79 KB, 下载次数: 5)

回复

使用道具举报

楼主| 发表于 2016-8-20 20:13 | 显示全部楼层

真了不起，不愧是学委，下来我再慢慢学习一下，谢谢

回复

使用道具举报

发表于 2016-8-21 14:41 | 显示全部楼层

给劳动者评个最佳哟

回复

使用道具举报

发新帖

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-5-19 00:31 , Processed in 0.561352 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表