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

笑眼晴天

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


效果

截止时间： 2015/1/15  21:00

younghuman

[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]

cleverzhzhf

继续凑热闹~~

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
    

复制代码

小丽_83

交练习了。。。

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. 
    
22. Sub 清除()
    
23.     Sheets("练习八").Range("c6:l" & Sheets("练习八").Range("a65535").End(3).Row).ClearContents
    
24.     '清除数据
    
25. End Sub

复制代码

毕释理

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

复制代码

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

Nami_excel

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

www.zhp

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不会分行，先交一部分

复制代码

笑眼晴天

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