ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

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

[求助] 紧急求助各路大神【指定数量、规则生成数组】可有偿

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-12-16 22:41 | 显示全部楼层 |阅读模式
紧急求助各路大神! image.png


指定数量、规则生成数组.rar

7.36 KB, 下载次数: 5

TA的精华主题

TA的得分主题

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

TA的精华主题

TA的得分主题

发表于 2019-12-17 06:52 | 显示全部楼层
'方案编号、怪物类型编号作为已知条件,输出H-K列,,,

Option Explicit

Sub test()
  Dim arr, i, j, k, t, dic, cnt, n
  Set dic = CreateObject("scripting.dictionary")
  arr = [a11].CurrentRegion.Resize(, 2)
  For i = 2 To UBound(arr, 1)
    dic(arr(i, 1)) = arr(i, 2)
  Next
  arr = [a1].CurrentRegion.Offset(1).Resize(, 11)
  For i = 1 To UBound(arr, 1) - 1
    cnt = cnt + 3
    For j = 8 To 10
      arr(i, j) = j + cnt - 10
    Next
    For j = 5 To 7
      n = 0
      For k = 1 To arr(i, j)
        n = n + 1
        t = t & ";" & "{" & arr(i, j + 3) & "," & arr(i, 1) & dic(arr(i, j - 3)) & n & "}"
      Next
    Next
    arr(i, 11) = Mid(t, 2): t = vbNullString
  Next
  [a2].Resize(UBound(arr, 1) - 1, UBound(arr, 2)) = arr
End Sub

评分

参与人数 1鲜花 +3 收起 理由
YZC51 + 3 太强大了

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-12-17 08:52 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-12-17 09:08 | 显示全部楼层
  1. Sub 生成内容()
  2.     Dim vData As Variant, nRow As Double, nCol As Integer
  3.     Dim oDic As Object, vFill As Variant
  4.     Dim vType As Variant, vNum As Variant, nIndex As Integer, sCode As String, nSerial As Double, nTotal As Double
  5.    
  6.     Set oDic = CreateObject("Scripting.Dictionary")
  7.     vData = [A11].CurrentRegion.Value
  8.     For nRow = 2 To UBound(vData)
  9.         If Trim(vData(nRow, 1)) <> "" Then oDic(Trim(vData(nRow, 1))) = vData(nRow, 2)
  10.     Next

  11.     vData = [A1].CurrentRegion.Value
  12.     ReDim vFill(2 To UBound(vData), 1 To 2)
  13.     For nRow = 2 To UBound(vData)
  14.         sCode = vData(nRow, 1)
  15.         nTotal = 0
  16.         For nCol = 1 To 3
  17.             vType = vData(nRow, 1 + nCol)
  18.             vNum = vData(nRow, 4 + nCol)
  19.             nSerial = nSerial + 1
  20.             If vNum > 0 Then
  21.                 For nIndex = 1 To vNum
  22.                     If vFill(nRow, 1) <> "" Then vFill(nRow, 1) = vFill(nRow, 1) & ","
  23.                     vFill(nRow, 1) = vFill(nRow, 1) & "{" & nSerial & "," & sCode & oDic(vType) & nIndex & "}"
  24.                 Next
  25.                 If vFill(nRow, 2) <> "" Then vFill(nRow, 2) = vFill(nRow, 2) & ","
  26.                 vFill(nRow, 2) = vFill(nRow, 2) & vType & vNum & "个"
  27.                 nTotal = nTotal + vNum
  28.             End If
  29.         Next
  30.         If nTotal > 0 Then
  31.             vFill(nRow, 2) = vFill(nRow, 2) & ",所以生成" & nTotal & "个"
  32.         End If
  33.     Next
  34.     [K2:L2].Resize(UBound(vFill) - 1) = vFill
  35. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2019-12-17 14:03 | 显示全部楼层
  1. '***************************************************************************
  2. 'http://club.excelhome.net/thread-1513039-1-1.html
  3. '***************************************************************************
  4. Sub 生成内容()

  5.     Dim gwId$ '怪物ID
  6.     Dim faBh$ '方案编号
  7.     Dim gwLx$ '怪物类型
  8.     Dim BcNum$ '波次
  9.     Dim gdNum$ '固定值
  10.     gdNum = "2"
  11.     Dim gwJy$ '怪物经验
  12.     Dim xgjzSum% '小怪近战数量
  13.     Dim xgycSum% '小怪远程数量
  14.     Dim xgjySum% ' 小怪精英数量
  15.     Dim gwDic As Object '怪物类型编号
  16.     Dim arr1 '临时数组
  17.     Dim gwRow& '方案行数
  18.     Dim scStr$ '生成内容
  19.     Set gwDic = CreateObject("Scripting.Dictionary")
  20.     With Sheet1
  21.         arr1 = .[A11].CurrentRegion.Value
  22.         For i = 2 To UBound(arr1)
  23.             If Trim(arr1(i, 1)) <> "" Then gwDic(Trim(arr1(i, 1))) = arr1(i, 2) '字典集
  24.         Next
  25.         Erase arr1 '清空数组
  26.         gwRow = .Range("A1").End(xlDown).Row
  27.         arr1 = .Range("A2:K" & gwRow)
  28.         For i = 1 To UBound(arr1)
  29.             faBh = arr1(i, 1) '方案编号
  30.             xgjzSum = arr1(i, 6) '小怪近战数量
  31.             xgycSum = arr1(i, 7) '小怪远程数量
  32.             xgjySum = arr1(i, 8) '小怪精英数量
  33.             BcNum = arr1(i, 5) '波次
  34. '______________________________________________________________________________________________________________________________
  35.             If xgjzSum > 0 Then
  36.                 gwId = arr1(i, 9) '怪物ID
  37.                 For j = 1 To xgjzSum
  38.                     Select Case BcNum
  39.                         Case "1"
  40.                             If xgjzSum < 10 Then
  41.                                 scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 2)) & "00" & CStr(0 + j) & "," & gdNum & "," & "1" & "}"
  42.                             Else
  43.                                 scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 2)) & "0" & CStr(0 + j) & "," & gdNum & "," & "1" & "}"
  44.                             End If
  45.                         Case "2"
  46.                             scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 2)) & "0" & CStr(25 + j) & "," & gdNum & "," & "1" & "}"
  47.                         Case "3"
  48.                             scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 2)) & "0" & CStr(50 + j) & "," & gdNum & "," & "1" & "}"
  49.                         Case "4"
  50.                             If xgjzSum = 25 Then
  51.                                 scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 2)) & "0" & CStr(75 + j) & "," & gdNum & "," & "1" & "}"
  52.                             Else
  53.                                 scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 2)) & 75 + CStr(j) & "," & gdNum & "," & "1" & "}"
  54.                             End If
  55.                     End Select
  56.                 Next
  57.             End If
  58. '______________________________________________________________________________________________________________________________
  59. '______________________________________________________________________________________________________________________________
  60.             If xgycSum > 0 Then
  61.                 gwId = arr1(i, 10) '怪物ID
  62.                 For j = 1 To xgycSum
  63.                     Select Case BcNum
  64.                         Case "1"
  65.                             If xgycSum < 10 Then
  66.                                 scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 3)) & "00" & CStr(0 + j) & "," & gdNum & "," & "1" & "}"
  67.                             Else
  68.                                 scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 3)) & "0" & CStr(0 + j) & "," & gdNum & "," & "1" & "}"
  69.                             End If
  70.                         Case "2"
  71.                             scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 3)) & "0" & CStr(25 + j) & "," & gdNum & "," & "1" & "}"
  72.                         Case "3"
  73.                             scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 3)) & "0" & CStr(50 + j) & "," & gdNum & "," & "1" & "}"
  74.                         Case "4"
  75.                             If xgycSum = 25 Then
  76.                                 scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 3)) & "0" & CStr(75 + j) & "," & gdNum & "," & "1" & "}"
  77.                             Else
  78.                                 scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 3)) & 75 + CStr(j) & "," & gdNum & "," & "1" & "}"
  79.                             End If
  80.                     End Select
  81.                 Next
  82.             End If
  83. '______________________________________________________________________________________________________________________________
  84. '______________________________________________________________________________________________________________________________
  85.             If xgjySum > 0 Then
  86.                 gwId = arr1(i, 11) '怪物ID
  87.                 For j = 1 To xgjySum
  88.                     Select Case BcNum
  89.                         Case "1"
  90.                             If xgjySum < 10 Then
  91.                                 scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 4)) & "00" & CStr(0 + j) & "," & gdNum & "," & "4.5" & "}"
  92.                             Else
  93.                                 scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 4)) & "0" & CStr(0 + j) & "," & gdNum & "," & "4.5" & "}"
  94.                             End If
  95.                         Case "2"
  96.                             scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 4)) & "0" & CStr(25 + j) & "," & gdNum & "," & "4.5" & "}"
  97.                         Case "3"
  98.                             scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 4)) & "0" & CStr(50 + j) & "," & gdNum & "," & "4.5" & "}"
  99.                         Case "4"
  100.                             If xgjySum = 25 Then
  101.                                 scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 4)) & "0" & CStr(75 + j) & "," & gdNum & "," & "4.5" & "}"
  102.                             Else
  103.                                 scStr = scStr & "{" & gwId & "," & faBh & gwDic(arr1(i, 4)) & 75 + CStr(j) & "," & gdNum & "," & "4.5" & "}"
  104.                             End If
  105.                     End Select
  106.                 Next
  107.             End If
  108. '______________________________________________________________________________________________________________________________
  109.             .Cells(i + 1, 12) = scStr
  110.             scStr = ""
  111.         Next
  112.     End With
  113.    
  114.     End Sub
复制代码


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

本版积分规则

关注官方微信,每天学会一个新技能

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

GMT+8, 2020-4-4 20:21 , Processed in 0.080616 second(s), 19 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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