白话Excel函数公式 Office易学宝微视频教程合集(Excel+Word+PPT)
笨办法学VBA(从入门到精通) 高效办公必会的Office实战技巧
财务总监的Excel私房课 网易云课堂-Excel数据透视表应用大全
Excel图表神技
查看: 1217|回复: 9

11126练习7-数据转换

[复制链接]
发表于 2015-1-6 11:33:17 | 显示全部楼层 |阅读模式
本帖最后由 zmnyu 于 2015-1-15 15:23 编辑


题目内容:
以下记录了某品牌服装的款号、数量等信息。
请将每种款式的服装分别整理为多行,每行的数量均为1,模拟效果如下图所示。
请直接提交VBA代码(以CODE形式贴出)。本练习题设置20登攀,优秀代码最多奖励10登攀。

模拟效果如下:



本题转自题库,由winnie_xyh老师提供,由leroy老师审核通过,答对可获得相应登攀。

截止日期:2015-1-13 21:00

评分标准:正确运行结果无误+20,每多一种方法+1,清除代码正确+5,总分30封顶。


11126练习7-数据转换.rar

119.07 KB, 下载次数: 18

回复

使用道具 举报

发表于 2015-1-6 14:50:01 | 显示全部楼层
本帖最后由 younghuman 于 2015-1-8 18:24 编辑

转换代码1
  1. Sub 方法1()
  2.     Dim i&, n&
  3.     n = 2
  4.     For i = 2 To Range("A1").CurrentRegion.Rows.Count
  5.         Range(Cells(i, 1), Cells(i, 4)).Copy Range(Cells(n, 8), Cells(n + Cells(i, 5).Value - 1, 11))
  6.         n = n + Cells(i, 5).Value
  7.     Next i
  8.     Range(Cells(2, 12), Cells(n - 1, 12)).Value = 1
  9. End Sub
复制代码

转换代码2
  1. Option Base 1

  2. Sub 方法2()
  3.     Dim arr(), i&, j&, k&, n&, s&
  4.     arr() = Range("A1").CurrentRegion
  5.     Range("H:K").NumberFormatLocal = "@"
  6.     n = 2
  7.     For i = 2 To UBound(arr, 1)
  8.         For k = 1 To arr(i, 5)
  9.             For j = 1 To 4
  10.                 Cells(n, j + 7) = arr(i, j)
  11.             Next j
  12.             Cells(n, 12) = 1
  13.             n = n + 1
  14.         Next k
  15.     Next i
  16. End Sub
复制代码

转换代码3(跟2类似)
  1. Option Base 1

  2. Sub 方法3()
  3.     Dim arr(), brr() As String
  4.     Dim i&, j&, k&, n&, s&
  5.     arr() = Range("A1").CurrentRegion
  6.     s = 1
  7.     For i = 2 To UBound(arr, 1)
  8.         s = s + arr(i, 5)
  9.     Next i
  10.     ReDim brr(2 To s, 1 To 4) As String
  11.     n = 2
  12.     For i = 2 To UBound(arr, 1)
  13.         For k = 1 To arr(i, 5)
  14.             For j = 1 To 4
  15.                 brr(n, j) = arr(i, j)
  16.             Next j
  17.             n = n + 1
  18.         Next k
  19.     Next i
  20.     Range("H2:K" & s) = brr()
  21.     Range("L2:L" & s) = 1
  22. End Sub
复制代码

清除代码
  1. Sub 清除结果()
  2.     Range(Cells(2, 8), Cells(2, 12).End(xlDown)).ClearContents
  3. End Sub
复制代码

点评

一看就是高手了,第一种方法很基础,后两种方法使用了数组,速度运行快,清除代码简洁,高效  发表于 2015-1-15 15:28

评分

参与人数 1登攀 +27 收起 理由
zmnyu + 27 很给力!

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-6 20:03:01 | 显示全部楼层
本帖最后由 sahara2010 于 2015-1-7 23:10 编辑
  1. Sub test()
  2.     Dim arr, brr, n%, i%, j%, m%, k% '定义变量
  3.     arr = [a1].CurrentRegion '获取源数据并赋值给数组
  4.     n = Application.Sum([E:E]) '求数量总和
  5.     ReDim brr(1 To n, 1 To 5)
  6.     For i = 2 To UBound(arr) '行循环
  7.         For j = 1 To arr(i, 5) '按照数量进入循环
  8.             k = k + 1: brr(k, 5) = 1
  9.             For m = 1 To 4
  10.                 brr(k, m) = arr(i, m)
  11.             Next
  12.         Next
  13.     Next
  14.     [h2].Resize(n, 5) = brr '将数组写入单元格区域
  15. End Sub
复制代码
  1. Sub test2()
  2.     Dim i%, j%, sum%
  3.     i = 2: j = 1
  4.     Do While Cells(i, 1) <> ""
  5.         sum = sum + Cells(i, 5)
  6.         Do Until j > sum
  7.             Cells(i, 1).Resize(i, 4).Copy Cells(j + 1, "h"): Cells(j + 1, "l") = 1
  8.             j = j + 1
  9.         Loop
  10.         i = i + 1
  11.     Loop
  12. End Sub
复制代码
  1. Sub test3()
  2.     Dim arr, i%, n%
  3.     [h:k].NumberFormatLocal = "@" '将H至K列设置文本格式
  4.     arr = [a1].CurrentRegion '将左侧数据赋值给数组arr
  5.     For i = 2 To UBound(arr)
  6.         Cells(n + 2, 8).Resize(arr(i, 5), 5) = Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4), 1)
  7.         n = n + arr(i, 5) '以数量作为Resize的第1参数扩展行数
  8.     Next
  9. End Sub
复制代码

点评

本班第一个用DO循环的,不错  发表于 2015-1-15 15:33

评分

参与人数 1登攀 +22 收起 理由
zmnyu + 22

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-8 14:45:01 | 显示全部楼层
本帖最后由 毕释理 于 2015-1-8 14:59 编辑
  1. Sub 拆分()
  2.     Dim I As Integer, r As Integer, j As Integer
  3.     j = 2
  4.     For r = 2 To 100
  5.         I = Range("e" & r)
  6.         Range("a" & r & ":d" & r).Copy Range("h" & j & ":h" & j + I - 1)
  7.         Range("L" & j & ":L" & j + I - 1) = 1
  8.         j = I + j
  9.     Next
  10. End Sub
复制代码
  1. Sub 清除()
  2.     Dim s As Integer, C As Integer
  3.     For s = 2 To 100
  4.         C = Range("E" & s) + C
  5.     Next
  6.     Range("H2:L" & C + 1).Clear
  7. End Sub
复制代码

点评

虽然基础差,但很认真,应该是本班收获最大的学员之一,加油!  发表于 2015-1-15 15:29

评分

参与人数 1登攀 +25 收起 理由
zmnyu + 25

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-8 15:32:46 | 显示全部楼层
这过程,写的好纠结呀
  1. Option Explicit
  2. Sub TransformNum()
  3.     Dim arr
  4.     Dim lngCol As Long
  5.     Dim i As Long, j As Long, m As Long, n As Long
  6.         arr = Sheets("汇总").Range("A1").CurrentRegion
  7.         lngCol = UBound(arr, 2)
  8.         ReDim brr(1 To 9999, 1 To lngCol)
  9.         For i = 2 To UBound(arr)
  10.             For m = m + n To m + n + arr(i, lngCol) - 1
  11.                 For j = 1 To lngCol - 1
  12.                     brr(m + 1, j) = arr(i, j)
  13.                 Next j
  14.                     brr(m + 1, lngCol) = 1
  15.             Next m
  16.         Next i
  17.     Sheets("汇总").Range("H2").Resize(m, lngCol) = brr
  18.     Sheets("汇总").Range("H1:L1").Value = Sheets("汇总").Range("A1:E1").Value
  19. End Sub
复制代码

点评

小翟老师不愧是万众瞩目的MVP,学啥啥有样,代码高端大气上档次啊  发表于 2015-1-15 15:30

评分

参与人数 1登攀 +20 收起 理由
zmnyu + 20

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-8 21:14:04 | 显示全部楼层
交练习了。。。

  1. Sub 转换()
  2.     Dim arr, targetarr, i%, j%, num%, irow%
  3.     arr = Sheets("汇总").Range("a2:e" & Sheets("汇总").Range("a65535").End(3).Row) '写入数组
  4.     ReDim targetarr(1 To 10000, 1 To 5) '定义数组
  5.     Sheets("汇总").Columns("i:k").NumberFormatLocal = "@" '将I至K列设为文本格式
  6.     '分别对行/重复次数/列进行循环
  7.     For i = 1 To UBound(arr) '对行进行循环
  8.         For j = 1 To arr(i, 5) '对重复次数进行循环
  9.             num = num + 1 '对目标数组行数进行统计
  10.             For irow = 1 To 4 '对A至D列进行循环
  11.                 targetarr(num, irow) = arr(i, irow) '写入目标数组
  12.                 targetarr(num, 5) = 1 '将目标数组第5行赋值为1
  13.             Next
  14.         Next
  15.     Next
  16.     Sheets("汇总").Range("h2").Resize(UBound(targetarr), 5) = targetarr '将目标数组写入单元格内
  17. End Sub

  18. Sub 清除()
  19.     Sheets("汇总").Range("h2:l" & Sheets("汇总").Range("h65535").End(3).Row).ClearContents '清除转换的区域
  20. End Sub
复制代码


11126 练习7 小丽.zip

135.9 KB, 下载次数: 2

点评

功底好,不解释  发表于 2015-1-15 15:32

评分

参与人数 1登攀 +25 收起 理由
zmnyu + 25

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-13 15:47:08 | 显示全部楼层
Sub 数据转换()
    For i = 2 To [b10000].End(3).Row
        Cells(2 + n, 8).Resize(Cells(i, 5), 1) = Cells(i, 1)
        Cells(2 + n, 9).Resize(Cells(i, 5), 1) = Cells(i, 2)
        Cells(2 + n, 10).Resize(Cells(i, 5), 1) = Cells(i, 3)
        Cells(2 + n, 11).Resize(Cells(i, 5), 1) = Cells(i, 4)
        Cells(2 + n, 12).Resize(Cells(i, 5), 1) = 1
        n = n + Cells(i, 5)
    Next
End Sub

点评

初级写到这样很不错了,继续努力!  发表于 2015-1-15 15:33

评分

参与人数 1登攀 +20 收起 理由
zmnyu + 20

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-13 17:12:56 | 显示全部楼层
赶在截至前了 谢谢批改

11126练习7-数据转换.rar

119.84 KB, 下载次数: 4

点评

学习要讲究方法,下次注意,有时间好好研究代码,弄懂方法,学到知识最可贵  发表于 2015-1-15 15:34
在技术论坛模拟求助解题方法,建议此答案不参与评分。  发表于 2015-1-13 22:04

评分

参与人数 1登攀 -1 收起 理由
zmnyu -1

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-15 10:01:00 | 显示全部楼层
Sub zhengli()
Dim i, j As Long
Dim t
i = 2
j = 1
Range("i1:i596").NumberFormatLocal = "@"
Range("k1:k596").NumberFormatLocal = "@"   '设置i列、k列单元格格式为文体格式
For Each t In Range("e2:e100").Value
   
Range("h" & i, "h" & i + t - 1).Value = Range("a" & j + 1).Value
Range("i" & i, "i" & i + t - 1).Value = Range("b" & j + 1).Value
Range("j" & i, "j" & i + t - 1).Value = Range("c" & j + 1).Value
Range("k" & i, "k" & i + t - 1).Value = Range("d" & j + 1).Value  '将源数据复制到目标数据单元格中
Range("l" & i, "l" & i + t - 1).Value = 1   '设置  L列数据为1
i = i + t
j = j + 1
Next

End Sub

点评

做题很细心,提前想到设置单元格格式,赞~  发表于 2015-1-15 15:35

评分

参与人数 1登攀 +15 收起 理由
zmnyu + 15 晚交 -5

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-15 10:01:54 | 显示全部楼层
本帖最后由 Nami_excel 于 2015-1-15 12:47 编辑
Nami_excel 发表于 2015-1-15 10:01
Sub zhengli()
Dim i, j As Long
Dim t


昨天在其他帖中找到!交的有点晚了!

评分

参与人数 1登攀 -1 收起 理由
zmnyu -1

查看全部评分

回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 入学

本版积分规则

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