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

banggemangxiexi

紧急求助各路大神！

banggemangxiexi

跪求~可qq或微信联系

一把小刀闯天下

'方案编号、怪物类型编号作为已知条件，输出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

我是来讨说法的

banggemangxiexi 发表于 2019-12-17 02:10
跪求~可qq或微信联系

如果还没解决，qq244370061

microyip

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

复制代码

NadrsSaber

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

复制代码