ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 361|回复: 16

[求助] 求助随机填入数据问题

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-10-8 17:45 | 显示全部楼层 |阅读模式
请大神指教如何才能做到将表2中的数据随机填入表1中,具体要求在文件中已说明,请大神帮帮忙!

待处理.rar

9.74 KB, 下载次数: 14

TA的精华主题

TA的得分主题

发表于 2019-10-8 20:59 | 显示全部楼层
1、把表2的两列写成一列
2、然后往下复制粘贴三次
3、再把这一列乱序
4、把表2的这一列数据复制转置粘贴到表1的每一行。

TA的精华主题

TA的得分主题

发表于 2019-10-9 00:13 | 显示全部楼层
求大佬优化代码
1.png

待处理.rar

25.68 KB, 下载次数: 5

TA的精华主题

TA的得分主题

发表于 2019-10-9 09:43 | 显示全部楼层
此方法只是解决了随机填充的问题,一行里面随机重复内容不能超过4次没有解决,看看哪个高手解决下
Option Explicit
Sub 随机填充()
    Dim arr As Variant, i As Integer, j As Integer, nr As String, rng As Range, h As Integer
    arr = Sheets("表2").Range("A1:B26")
   For Each rng In Sheets("表1").Range("A2:L32")
    i = Application.WorksheetFunction.RandBetween(1, 26) '表2单元格A列的随机行数
    j = Application.WorksheetFunction.RandBetween(1, 2) '表2单元格B列的随机列数
        Select Case rng.Value
        Case Is = ""
            rng.Value = arr(i, j)
        Case Is <> ""
            rng.Value = rng.Value
        End Select
    Next
    End Sub


待处理.rar

20.64 KB, 下载次数: 7

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-9 12:54 | 显示全部楼层
excelvlookup 发表于 2019-10-8 20:59
1、把表2的两列写成一列
2、然后往下复制粘贴三次
3、再把这一列乱序

你这方法原理到是很简单,不过我表中给出的条件只是一部分,还有一部分要求没给出来,所以不能最终完成。不过方法很好,给了我们另一种思路

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-9 12:55 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-9 12:56 | 显示全部楼层
yuan1988 发表于 2019-10-9 09:43
此方法只是解决了随机填充的问题,一行里面随机重复内容不能超过4次没有解决,看看哪个高手解决下
Option  ...

感谢大神,能前进一步算一步嘛。

TA的精华主题

TA的得分主题

发表于 2019-10-9 22:08 | 显示全部楼层
xiongwang3 发表于 2019-10-9 12:54
你这方法原理到是很简单,不过我表中给出的条件只是一部分,还有一部分要求没给出来,所以不能最终 ...

Sub aa()
ar = Sheet2.Range("a1:b26")
br = Sheet1.Range("a2:l32")
ReDim arr(1 To UBound(ar) * 8)
For i = 1 To 4
    For j = 1 To 2
        For k = 1 To 26
            s = s + 1
            arr(s) = ar(k, j)
        Next
    Next
Next
'============写四遍
Randomize
For i = 1 To UBound(arr)
    x = Int(Rnd * (UBound(arr) - i + 1)) + i
    t = arr(i): arr(i) = arr(x): arr(x) = t
Next
'=========乱序
s = 1
For i = 1 To 31
    For j = 1 To 12
        If s > UBound(arr) Then s = 1
        If br(i, j) = "" Then
            br(i, j) = arr(s)
            s = s + 1
        End If
    Next
Next
'=========填充
Sheet1.Range("a2").Resize(31, 12) = br
End Sub
还有啥条件没给出来?????快快道来

TA的精华主题

TA的得分主题

发表于 2019-10-9 22:34 | 显示全部楼层
道理讲清楚了,用数学计算出随机数代表的字母,直接填充,可以让代码更简单高效

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-10 18:04 | 显示全部楼层
本帖最后由 xiongwang3 于 2019-10-10 19:37 编辑
excelvlookup 发表于 2019-10-9 22:08
Sub aa()
ar = Sheet2.Range("a1:b26")
br = Sheet1.Range("a2:l32")

传不了附件和图片。。。。我描述下问题吧。在表2的C列中,增加一个数据,就只有一个数据。除已经满足的以上所有条件外,还需要:表2中C列的那一个数据,在表1中每列必须出现,但每列最多出现2次。也需要避开非空单元格。   麻烦大神再帮我研究下

难度增加.rar

10.09 KB, 下载次数: 1

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-12-13 11:03 , Processed in 0.443612 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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