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

【11126】练习8 数据整理及填充

[复制链接]
发表于 2015-1-8 10:42:03 | 显示全部楼层 |阅读模式
本帖最后由 笑眼晴天 于 2015-1-18 16:12 编辑

根据附件内容整理数据并填充。题目及要求
题目及要求.png

效果
效果图.png
截止时间: 2015/1/15  21:00

练习八.rar

24.82 KB, 下载次数: 49

回复

使用道具 举报

发表于 2015-1-8 14:36:11 | 显示全部楼层
本帖最后由 younghuman 于 2015-1-8 14:44 编辑

[code=vb]
Sub bianhao()
    Dim i&, j&, k&, x&, y&
    x = 6: y = 3
    For i = 1 To 2
        For j = 1 To 10
            For k = 0 To 2
                Cells(x, y).Value = Left(Cells(i * 2, j + 2), 5) & _
                               Format(Mid(Cells(i * 2, j + 2), 6, 3) + k * 2, "000") & _
                               Right(Cells(i * 2, j + 2), 3)
                y = y + 1
                If y = 13 Then y = 3: x = x + 2
            Next k
        Next j
    Next i
End Sub
[/code]

点评

班长应该用数组做啊,单元格循环太慢了。  发表于 2015-1-18 09:07

评分

参与人数 1登攀 +20 收起 理由
笑眼晴天 + 20 很给力!

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-8 15:04:39 | 显示全部楼层
继续凑热闹~~
  1. Sub Filling()
  2.     Dim arr
  3.     Dim i As Long, j As Long, k As Long, m As Long, n As Long
  4.     Dim strNum As String
  5.     With Sheets("练习八")
  6.         arr = .Range("C2:L4")
  7.         ReDim brr(1 To 999, 1 To UBound(arr, 2))
  8.         m = 1: n = 0
  9.         For i = 1 To 3 Step 2
  10.             For j = 1 To UBound(arr, 2)
  11.                 For k = 0 To 4 Step 2
  12.                     strNum = Format(Mid(arr(i, j), 6, 3) + k, "000")
  13.                     If n = UBound(arr, 2) Then
  14.                         m = m + 2: n = 1
  15.                     Else
  16.                         n = n + 1
  17.                     End If
  18.                     brr(m, n) = Left(arr(i, j), 5) & strNum & Mid(arr(i, j), 9, 99)
  19.                 Next k
  20.             Next j
  21.         Next i
  22.         .Range("C6").Resize(m, UBound(arr, 2)) = brr
  23.     End With
  24. End Sub
复制代码

点评

小翟老师的代码真厉害。O(∩_∩)O~  发表于 2015-1-18 09:20

评分

参与人数 1登攀 +20 收起 理由
笑眼晴天 + 20

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-8 22:52:46 | 显示全部楼层
交练习了。。。

  1. Sub 调整数据()
  2.     Dim arr, targetarr, i%, j%, irow%, jrow%, num%
  3.     arr = Sheets("练习八").Range("c2:l4") '将数据源写入数组
  4.     ReDim targetarr(1 To 100, 1 To 10)
  5.     irow = 1 '设置目标数组行数开始值为1
  6.     For i = 1 To 3 Step 2 '因数据行是隔行的,故步长设为2
  7.         For j = 1 To UBound(arr, 2) '对数据源列数进行循环
  8.             For num = 0 To 2 '每次增加num*2
  9.                 jrow = jrow + 1
  10.                 '目标数列数
  11.                 If jrow > 10 Then irow = irow + 2: jrow = 1
  12.                 '如果超过10列即另起一列,步长为2,且将列数恢复为1
  13.                 targetarr(irow, jrow) = VBA.Left(arr(i, j), 5) & VBA.Format(VBA.Mid(arr(i, j), 6, 3) + num * 2, "000") & "左拱墙"
  14.                 '目标数组等于数据源单元格前5位 & 6-8位+num*2 & 左拱墙
  15.             Next
  16.         Next
  17.     Next
  18.     Sheets("练习八").Range("c6").Resize(UBound(targetarr), 10) = targetarr
  19.     '将目标数组写入单元格
  20. End Sub

  21. Sub 清除()
  22.     Sheets("练习八").Range("c6:l" & Sheets("练习八").Range("a65535").End(3).Row).ClearContents
  23.     '清除数据
  24. End Sub
复制代码


11126 练习8 小丽.zip

28.17 KB, 下载次数: 2

点评

有注释。另外写了清除数据。赞一个。  发表于 2015-1-18 09:27

评分

参与人数 1登攀 +20 收起 理由
笑眼晴天 + 20 赞一个!

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-10 10:56:27 | 显示全部楼层
  1. Sub 整理()
  2.     Dim arr As Variant, num As String, i As Integer, j As Integer
  3.     Dim r As Byte, e As Byte
  4.     arr = Range("c2:l4")     '定义区域
  5.     r = 6
  6.     j = 3
  7.     For e = 1 To 3 Step 2
  8.         For i = 1 To 10
  9.             num = Left(Split(arr(e, i), "-")(1), 3)    '截取-后面的3位数字
  10.             For s = 0 To 4 Step 2
  11.                 If Len(num + s) = 1 Then           '如果这3位数分别加0,2,4后的结果长度为1
  12.                     Cells(r, j) = Split(arr(e, i), "-")(0) & "-00" & num + s & "左拱墙"    '-后面加00再跟加起来的结果组合
  13.                 ElseIf Len(num + s) = 2 Then
  14.                     Cells(r, j) = Split(arr(e, i), "-")(0) & "-0" & num + s & "左拱墙"     '-后面加0再跟加起来的结果组合
  15.                 ElseIf Len(num + s) = 3 Then
  16.                     Cells(r, j) = Split(arr(e, i), "-")(0) & "-" & num + s & "左拱墙"      '-直接采用相加后的结果
  17.                 Else: Cells(r, j) = "K10" & Right(Split(arr(e, i), "-")(0), 1) + 1 & "-" & Right(num + s, 3) & "左拱墙"
  18.                     '如果长度大于3,则-前面的数字加1,-后面只采用相加后的数值的后3位
  19.                 End If
  20.                 j = j + 1
  21.                 If j > 12 Then
  22.                     r = r + 2
  23.                     j = 3
  24.                 End If
  25.             Next s
  26.         Next i
  27.     Next e
  28. End Sub
复制代码


如果这就是╮(╯▽╰)╭~~~~~~~~

练习八.zip

29.54 KB, 下载次数: 3

点评

自己添加了一个控件,挺好的。数组arr在这里的作用不是很大,具体数组的使用可以看看楼上的代码。Split的部分也可以直接用mid。  发表于 2015-1-18 15:46

评分

参与人数 1登攀 +20 收起 理由
笑眼晴天 + 20 赞一个!

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-15 12:45:08 | 显示全部楼层
本帖最后由 Nami_excel 于 2015-1-15 16:19 编辑

Sub shujuzhengli2()
    Dim i, j, k As Long
    Dim a1, a2, a3 As Long
    Dim b, c, d, e As String
    k = 1
    For i = 2 To 4 Step 2   '行值变量定义
        For j = 3 To 12       '列值变更定义
            a1 = Mid(Cells(i, j), 6, 3)
            a2 = Mid(Cells(i, j), 6, 1)   '字符串截取
            For m = 0 To 4 Step 2
                a3 = a1 + m                'a1+0、2、4
                If a2 = 0 Then
                    e = "0" & a3
                Else: e = a3
                End If
                b = Left(Cells(i, j), 5)
                c = Right(Cells(i, j), 3)
                d = b & e & c       '字符串合并
                Cells(k, "M") = d    '暂存在m 列
                k = k + 1
            Next
        Next
    Next
    Call tianchong
    Call clear
End Sub

Sub tianchong()
    Dim i, j, k As Long

    k = 1
    For i = 6 To 16 Step 2       '将m列数据填写到指定单元格
        For j = 3 To 12
            Cells(i, j).Value = Cells(k, "m").Value
            k = k + 1
        Next
    Next
End Sub

Sub clear()
    Range("m1:m60").clear   '清空m列
End Sub

点评

先通过代码把数据整理写到M列,再填充到相应的单元格。能想到这种处理方法,挺不错的。这里可以直接加循环判断或者写进数组,就能直接填充。开贴后可以参考其他同学的方法。  发表于 2015-1-18 15:54

评分

参与人数 1登攀 +20 收起 理由
笑眼晴天 + 20 很给力!

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-1-17 19:25:29 | 显示全部楼层
  1. Sub 拆分()
  2. Dim k As String, i As Integer, j As Integer, a As String, b As String, h As String
  3. a = 6
  4. b = 3
  5.     For i = 2 To 4 Step 2
  6.         For j = 3 To 10
  7.             k = Mid(Cells(i, j), 1, 6)
  8.                 l = Mid(Cells(i, j), 7, 2) * 1
  9.                 m = Mid(Cells(i, j), 9, 3)
  10.                 Cells(a, b + 0) = k & l + 0 & m
  11.                     If Cells(a, 12) <> "" Then
  12.                         a = a + 2
  13.                         b = 3
  14.                         Cells(a, b + 0) = k & l + 2 & m
  15.                         Cells(a, b + 1) = k & l + 4 & m
  16.                     End If
  17.                     Cells(a, b + 1) = k & l + 2 & m
  18.                     Cells(a, b + 2) = k & l + 4 & m
  19.                     If Cells(a, 12) <> "" Then
  20.                         a = a + 2
  21.                         b = 3
  22.                     Else
  23.                             b = b + 3
  24.                     End If
  25.         Next j
  26.     Next i
  27. End Sub不会分行,先交一部分
复制代码

点评

未达到效果。换行之后,并不是中间数据绝对地在下一行加上2或者4。具体代码可以看其他同学的。  发表于 2015-1-18 16:06

评分

参与人数 1登攀 +10 收起 理由
笑眼晴天 + 10 加油。

查看全部评分

回复 支持 反对

使用道具 举报

 楼主| 发表于 2015-1-18 16:10:26 | 显示全部楼层
本帖最后由 笑眼晴天 于 2015-1-18 16:12 编辑

这题方法基本都是分列,中间数据加上相对应的数值。加上循环处理,以及format的使用(或者字符串直接连接)。
数组和单元格循环上面的回复中都有,可以去比较下哪种相对更有效率,并学习代码。
回复 支持 反对

使用道具 举报

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

本版积分规则

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