多列数据装入字典，重新排列后录入工作表

枫丹白露

我要将《订单》表内有28列数据，有选择的装11列到字典，并按列序重新排列，显示在listbox
再录入到《排单计划》表

在字典这里卡住了，请老师帮我写一段代码，谢谢。


搞定了，是我想复杂了

1. Private Sub UserForm_Initialize() '窗体初始化
   
2.     Dim arr, brr(), k, j, x, r
   
3.      r = Sheet3.Cells(Rows.Count, "r").End(xlUp).Row
   
4.      arr = Sheet3.Range("C4:AB" & r) '数据源
   
5.      
   
6.         k = 0
   
7.     For x = 1 To UBound(arr)
   
8.         ReDim Preserve brr(1 To UBound(arr), 1 To 12)
   
9.         
   
10.            If arr(x, 24) <> 0 Then
    
11.              k = k + 1
    
12.             
    
13.             brr(k, 1) = arr(x, 1) '客户
    
14.             brr(k, 2) = arr(x, 6) '简称
    
15.             brr(k, 3) = arr(x, 24) '欠数
    
16.             brr(k, 4) = arr(x, 18) '合同号
    
17.             brr(k, 5) = arr(x, 19) '订单号
    
18.             brr(k, 6) = arr(x, 20) '编码
    
19.             brr(k, 7) = arr(x, 21) '物料
    
20.             brr(k, 8) = arr(x, 26) '配置
    
21.             brr(k, 9) = arr(x, 3) '工装
    
22.             brr(k, 10) = arr(x, 4) '流转号
    
23.             brr(k, 11) = arr(x, 5) '品名
    
24.             brr(k, 12) = arr(x, 16) '备注
    
25.                   
    
26.          End If
    
27.     Next
    
28. 
    
29. ListBox1.List = brr
    
30. With ListBox1 '设置列表框属性
    
31.     .Font.Size = 10 '字号12
    
32.     .ForeColor = RGB(233, 9, 248) '字色蓝
    
33.     .ColumnCount = 12 '列数
    
34.     .ColumnWidths = "65,220,30,70,2,2,2,180,2,2,2,100" '列宽
    
35. End With
    
36. End Sub
    
37. 
    
38. 
    
39. 
    
40. 
    
41. 
    

复制代码

taller

'第1列客户，第2列内部简称，第3列订单欠数，第4列合同号，第5列订单号，第6列编码，第7列物料，第8列工装，第9列流转号，第10列品名，第11列短码  - 请确保需求中列名和第2列标题行完全一致，否则无法对应

taller

另外，你的需求无需去重或者计数，为啥要使用字典呢？直接由arr数组中提取相应列保存到brr数组中就可以了

3190496160

Private Sub UserForm_Initialize() '窗体初始化
Dim d As Object, arr, brr(), i&, j&, k&, s$
r = Sheet3.Cells(Rows.Count, "c").Row
If r < 4 Then MsgBox "订单为空，请先录入数据！": End
arr = Sheet3.Range("a3:ab" & r) '数据源
ReDim brr(1 To UBound(arr), 1 To 17)
For i = 1 To UBound(arr) '遍历数组arr
    If arr(i, 3) <> "" Then
        n = n + 1
        brr(n, 1) = n
        For j = 20 To 23
            brr(n, j - 18) = arr(i, j)
        Next j
        brr(n, 6) = arr(i, 26)
        For j = 5 To 7
            brr(n, j + 2) = arr(i, j)
        Next j
        brr(n, 17) = arr(i, 3)
    End If
Next i
With ListBox1 '设置列表框属性
    .List = brr
    .Font.Size = 11 '字号12
    .ForeColor = vbBlue '字色蓝
    .ColumnCount = 17 '列数
    .ColumnWidths = "20,70,50,50,50,45,42,45,45,45,45,45" '列宽
End With
End Sub

3190496160

褚兄有一句话印象特别深刻：基础不牢，地动山摇，确实很有道理

3190496160

订单录入.rar (105.75 KB, 下载次数: 15)

2024-4-26 10:15 上传

点击文件名下载附件

枫丹白露

taller 发表于 2024-4-26 06:31
另外，你的需求无需去重或者计数，为啥要使用字典呢？直接由arr数组中提取相应列保存到brr数组中就可以了

本来是想用数组的，但数组不能按我要的列序提取到listbox里，帮我写一个代码，可以吗？谢谢

枫丹白露

3190496160 发表于 2024-4-26 10:14
Private Sub UserForm_Initialize() '窗体初始化
Dim d As Object, arr, brr(), i&, j&, k&, s$
r = Shee ...

谢谢，测试了内存溢出，好象是这句不对：  .List = brr

taller

枫丹白露 发表于 2024-4-26 10:31
本来是想用数组的，但数组不能按我要的列序提取到listbox里，帮我写一个代码，可以吗？谢谢

为什么不能按要求提取？你尝试过什么代码？

2楼问题没有解决的话，没法有代码

枫丹白露

taller 发表于 2024-4-26 10:47
为什么不能按要求提取？你尝试过什么代码？

2楼问题没有解决的话，没法有代码

2楼的那些列名，都是存在的，数据源《订单》 中，是有这些列名的，只是排列不同（因为有28列，我只需要其中11列），所以要重新排列