
本文于2023年10月6日首发于本人同名其他平台,更多文章案例请搜索关注!
内容提要
数据结构转换(客户订单调单表)/一维表转二维表/二维表转一维表代码
1、在myModule里,OneToTwo过程:
Sub OneToTwo()
Dim ws As Worksheet
Dim wsSO_TF As Worksheet
Dim wsWL_TF As Worksheet
Dim wsSO_TB As Worksheet
Dim arr(), arrTem()
Dim lastRow As Integer
Dim dicQuantity As Object
Dim dicCustomer As Object
Dim dicOrder As Object
Dim dKey As String
Dim sumRng As Range
Set dicQuantity = CreateObject("Scripting.Dictionary")
Set dicCustomer = CreateObject("Scripting.Dictionary")
Set dicOrder = CreateObject("Scripting.Dictionary")
Set ws = ThisWorkbook.Sheets("调单")
Set wsSO_TF = ThisWorkbook.Sheets("SO_TF")
Set wsWL_TF = ThisWorkbook.Sheets("WL_TF")
Set wsSO_TB = ThisWorkbook.Sheets("SO_TB")
With ws
lastRow = .UsedRange.Rows.Count
arr = .Range("A1:D" & lastRow).Value '基础数据存入数组
arrTem = wsWL_TF.Range("A1").CurrentRegion.Value '基础数量
For i = 1 To UBound(arrTem)
dicQuantity(arrTem(i, 2)) = arrTem(i, 3)
Next
For i = 3 To UBound(arr) '更新基础数量
If dicQuantity.exists(arr(i, 2)) Then
arr(i, 3) = dicQuantity(arr(i, 2))
End If
Next
'处理订单数据,存入字典
arrTem = wsSO_TF.Range("A1").CurrentRegion.Value
For i = 2 To UBound(arrTem)
dicCustomer(arrTem(i, 7)) = arrTem(i, 6) '以订单号作为key,客户名称作为ITEM
dKey = arrTem(i, 2) & "|" & arrTem(i, 7)
dicOrder(dKey) = dicOrder(dKey) + Val(arrTem(i, 5))
Next
'把订单数据存入arr
k = UBound(arr, 2) + 1
r = UBound(arr)
For Each Key In dicCustomer.keys '表头订单号,客户字段
ReDim Preserve arr(1 To r, 1 To k)
arr(1, k) = Key
arr(2, k) = dicCustomer(Key)
k = k + 1
Next
For i = 3 To UBound(arr)
For j = 5 To UBound(arr, 2)
arr(i, j) = dicOrder(arr(i, 2) & "|" & arr(1, j))
Next
Next
k = UBound(arr, 2)
ReDim Preserve arr(1 To r, 1 To k + 3)
arr(2, k + 1) = "销售合计"
arr(2, k + 2) = "辅助列"
arr(2, k + 3) = "剩余数量"
.Cells.ClearContents
.Range("A1").Resize(r, k + 3) = arr
For i = 3 To r
Set sumRng = Range(Cells(i, 5), Cells(i, k))
.Cells(i, k + 1).Formula = "=SUM(" & sumRng.Address & ")"
.Cells(i, k + 3).Formula = "=" & .Cells(i, 3).Address & "-" & .Cells(i, k + 1).Address & "+" & .Cells(i, k + 2).Address
Next
End With
End Sub
代码解析:
(1)Line2~12,定义一些变量。工作表对象、字典对象等。
(2)line13~15,创建字典对象。
(3)line16~19,创建工作表对象,共4个工作表,都给它装到对象中去,方便引用操作。
(4)line22,把调单表A~D列数据装入数组arr。
(5)line23,把WL_TF表数据装入数组arrTem,这里arrTem作为临时数组,在后面会多次重复使用,本来是把每个工作表对应定义一个数组的,后来发现完全没有必要。
(6)line24~26,循环数组arrTem,把“品号”作为key,“基础数量”作为item,装入字典dicQuantity。
(7)line27~31,把数组arr中的数量根据dicQuantity数据进行更新,这里用了一个IF判断,意思就是如果在dicQuantity中没有找到对应数据,则保留arr中原有的数据。
(8)line33,把订单表(SO_TF)装入数组arrTem。
(9)line34~38,循环数组arrTem,把订单号作为Key,客户名称作为iten,装入字典dicCustomer,这里要考虑一下,订单号与客户名称哪个最具有唯一性,在本案例中,一个订单号对应一个客户。起初我是把客户作为key,订单号作为item的,后来考虑到一个客户可能有多个订单,所以就把它们掉了一个个。
把arrTem的第二列(品号)、第七列(订单号)组合为字符串dKey,加入字典dicOrder中,item为第五列(数量),注意,这里的数量我们用了汇总的方法。在本案例中,每个订单中的每个品号的数量是唯一的,不汇总也行,但以防万一嘛。
(10)line42~47,循环dicCustomer的所有key,将arr随之扩展,把订单号、客户名称逐一填入数组arr的表头列中。
(11)line48~52,从数组arrr的第3行,第5列开始循环每一个元素,把其对应的第二列、第一行字段组合成字符串dKey,到字典dicOrder中去取值,填到该元素中。
(12)line53~59,把arr再扩展三列,填上表头字段,把“调单”表单元格清空,把arr数据写入工作表。
(13)line60~66,循环工作表,在倒数第3列添加汇总公式,最后一列添加计算公式。
2、在myModule里,TwoToOne过程过程:
Sub TwoToOne()
Dim ws As Worksheet
Dim wsSO_TB As Worksheet
Dim lastRow As Integer
Dim lastCol As Integer
Dim arr()
Dim arrSO_TB()
Set ws = ThisWorkbook.Sheets("调单")
Set wsSO_TB = ThisWorkbook.Sheets("SO_TB")
With ws
lastRow = ws.UsedRange.Rows.Count
lastCol = ws.UsedRange.Columns.Count
arr = ws.Range(.Cells(1, 1), .Cells(lastRow, lastCol)).Value
End With
ReDim arrSO_TB(1 To 6, 1 To 1)
For i = 1 To 4
arrSO_TB(i, 1) = arr(2, i)
Next
arrSO_TB(3, 1) = "数量"
arrSO_TB(5, 1) = "订单单号"
arrSO_TB(6, 1) = "客户"
k = 2
For i = 5 To UBound(arr, 2) - 3
For j = 3 To UBound(arr)
If Val(arr(j, i)) <> 0 Then
ReDim Preserve arrSO_TB(1 To 6, 1 To k)
arrSO_TB(1, k) = arr(j, 1)
arrSO_TB(2, k) = arr(j, 2)
arrSO_TB(3, k) = arr(j, i)
arrSO_TB(4, k) = arr(j, 4)
arrSO_TB(5, k) = arr(1, i)
arrSO_TB(6, k) = arr(2, i)
k = k + 1
End If
Next
Next
wsSO_TB.Activate
Cells(1, 1).Select
wsSO_TB.Cells.ClearContents
wsSO_TB.Range("A1").Resize(UBound(arrSO_TB, 2), UBound(arrSO_TB)) = Application.WorksheetFunction.Transpose(arrSO_TB)
wsSO_TB.Range("A1").Resize(UBound(arrSO_TB, 2), UBound(arrSO_TB)).Borders.LineStyle = xlContinuous
End Sub
代码解析:
(1)Line1~7,定义一些变量。工作表对象、数组等。
(2)line13,把“调单”表装入数组arr()。
(3)line15,重定义数组arrSO_TB为6行1列的数组
(4)Line16~21,在数组arrSO_TB的第一列写入表头字段。
(5)line22~36,从第5列,第3行开始,循环数组arr,遇到不为0的元素,就将数组arrSO_TB扩展一列,填入对应数据。
我们在循环数组的时候,通常是先循环行、然后循环列,但我们这里反过来,主要目的是把每个客户的数据放到一起。
(6)line37~38,激活工作表SO_TB,选中第一个单元格,确保显示表头。
(7)line39~41,清空工作表SO_TB,写入arrSO_TB的数据,数据区域划线。
3、在工作表“调单“里,两个命令按钮:
Private Sub CmdOneToTwo_Click()
Call OneToTwo
End Sub
Private Sub CmdTwoToOne_Click()
Call TwoToOne
End Sub
~~~~~~End~~~~~~
喜欢就点个赞、点在看、留言评论、分享一下呗!感谢支持!