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

课时1练习2-按指定次数重复数字

[复制链接]
发表于 2015-8-3 21:02:00 | 显示全部楼层 |阅读模式
本帖最后由 临时户口 于 2015-8-17 21:53 编辑

具体要求见附件。本题50dp。函数解答只有10dp。只需提交代码,无需上传文件。
截止日期2015-8-12

本题由ys19840718老师提供



11127课时1练习2-按指定次数重复数字.rar

14.56 KB, 下载次数: 43

回复

使用道具 举报

发表于 2015-8-4 13:30:10 | 显示全部楼层
本帖最后由 lilyren 于 2015-8-8 10:24 编辑
  1. Sub 练习2()
  2.     Dim b&, rng As Range, c&
  3.     b = Cells(Rows.Count, 1).End(xlUp).Row
  4.     For Each rng In Range("a2:a" & b)
  5.         c = Cells(Rows.Count, 2).End(xlUp).Row
  6.         Range("b" & c + 1).Resize(rng.Value, 1) = rng.Value
  7.     Next
  8. End Sub
复制代码

点评

可以借助offset属性来做  发表于 2015-8-17 21:54

评分

参与人数 1登攀 +50 收起 理由
临时户口 + 50

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-8-4 15:34:05 | 显示全部楼层
练习2
  1. Sub chongfu()
  2.     Dim m%, i%, k%
  3.     m = 3
  4.         For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
  5.             msgtr = Range("a" & i)
  6.                 For k = 1 To msgtr
  7.                     Range("b" & m - 1) = Cells(i, 1)
  8.                     m = m + 1
  9.                 Next
  10.         Next
  11. End Sub
复制代码

点评

m变量多余了完全可以用offset来帮助  发表于 2015-8-17 22:24

评分

参与人数 1登攀 +50 收起 理由
临时户口 + 50

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-8-4 16:07:17 | 显示全部楼层
本帖最后由 q614081052 于 2015-8-4 22:17 编辑
  1. Sub 练习2第一种方法()
  2.     With Sheet3
  3.         Application.ScreenUpdating = False
  4.         Dim arr, i&, brr, j&, irow&, k&, erow&
  5.         irow = WorksheetFunction.Sum(.Range("a2:a" & Cells(Rows.Count, 1).End(3).Row))
  6.         erow = Cells(Rows.Count, 1).End(3).Row
  7.         .Range("b2:b500").ClearContents
  8.         If erow < 2 Then End
  9.         If erow = 2 Then
  10.             For i = 2 To .Range("a2") + 1
  11.                 .Range("b" & i) = .Range("a2").Value
  12.             Next
  13.         Else
  14.             ReDim brr(1 To irow)
  15.             arr = .Range("a2:a" & erow)
  16.             For i = 2 To UBound(arr) + 1
  17.                 For j = i - 1 To i + .Range("a" & i) - 2
  18.                     k = k + 1
  19.                     brr(k) = arr(i - 1, 1)
  20.                 Next
  21.             Next
  22.             .Range("b2").Resize(UBound(brr)) = WorksheetFunction.Transpose(brr)
  23.         End If
  24.     End With
  25.     Application.ScreenUpdating = True
  26. End Sub

  27. Sub 练习2第二种方法()
  28.     Dim i&, arr, irow&, str, j&, p
  29.     Application.ScreenUpdating = False
  30.     With Sheet3
  31.          .Range("b2:b500").ClearContents
  32.         irow = Cells(Rows.Count, 1).End(3).Row
  33.         If irow < 2 Then End
  34.         If irow = 2 Then
  35.             For i = 2 To .Range("a2") + 1
  36.                 .Range("b" & i) = .Range("a2").Value
  37.             Next
  38.         Else
  39.             arr = .Range("a2:a" & irow)
  40.             For i = 1 To irow - 1
  41.                 For j = 1 To arr(i, 1)
  42.                     str = str & "!" & arr(i, 1)
  43.                 Next
  44.             Next i
  45.             p = Split(str, "!")
  46.             ReDim brr(1 To UBound(p))
  47.             For i = 1 To UBound(p)
  48.                 brr(i) = p(i)
  49.             Next
  50.             .Range("b2").Resize(UBound(brr)) = WorksheetFunction.Transpose(brr)
  51.         End If
  52.     End With
  53.     Application.ScreenUpdating = True
  54. End Sub

  55. Sub 练习2第三种方法()
  56.     Dim dr&, i&, sr&
  57.     Application.ScreenUpdating = False
  58.     With Sheet3
  59.         sr = .Cells(Rows.Count, 1).End(xlUp).Row '设定变量sr为A列非空最后一行的行号
  60.         .Range("b2").Resize(.Cells(Rows.Count, 2).End(xlUp).Row, 1).ClearContents '清除B列非空单元格的数值
  61.         For i = 2 To sr '循环A列各非空单元格的值
  62.             dr = .Cells(Rows.Count, 2).End(xlUp).Row + 1 '设定变量dr为B列第一个空单元格的行号
  63.             Range("b" & dr).Resize(Range("a" & i).Value, 1) = Range("a" & i).Value '把A列中的数据,根据本身的数值大小重复相应次数,然后将获得的新数据按原顺序依次放入B列
  64.         Next
  65.     End With
  66.     Application.ScreenUpdating = True
  67. End Sub

  68. Sub 练习2第四种方法()
  69.     Dim i As Integer, j As Integer, k As Integer
  70.     Application.ScreenUpdating = False
  71.     With Sheets3
  72.         .Range("b2:b500").Clear
  73.         k = 1
  74.         For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
  75.             For j = 1 To .Cells(i, 1)
  76.                 k = k + 1
  77.                 .Cells(k, 2) = .Cells(i, 1)
  78.             Next j
  79.         Next i
  80.     End With
  81.     Application.ScreenUpdating = True
  82. End Sub
复制代码

点评

第一种完全虐自己想那么复杂的算他的坐标  发表于 2015-8-17 22:33

评分

参与人数 1登攀 +50 收起 理由
临时户口 + 50

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-8-11 12:36:20 | 显示全部楼层
函数法:B2数组公式下拉
  1. =INDEX(A$1:A$9,SMALL(IF(A$2:A$8>=COLUMN(A1:H1),ROW(A$2:A$8),9),ROW(A1)))&""
复制代码


VBA法:

  1. Sub 练习2()
  2.     Dim i, j, k As Long
  3.     Dim arow As Long
  4.     arow = [A65536].End(xlUp).Row                '获取A列行数
  5.     j = 1
  6.     For i = 2 To arow                            '循环区间
  7.         If Range("a" & i) <> 0 Then
  8.         j = Range("a" & i) + j                   'A列合计数
  9.             For k = 2 To j
  10.                 If Range("b" & k) = "" Then
  11.                 Range("b" & k) = Range("a" & i)  '给B列赋值
  12.                 End If
  13.             Next
  14.         End If
  15.     Next
  16. End Sub
复制代码


评分

参与人数 1登攀 +50 收起 理由
临时户口 + 50

查看全部评分

回复 支持 反对

使用道具 举报

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

本版积分规则

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