excel学习库

excel表格_excel函数公式大全_execl从入门到精通

Excel VBA「代码」数据结构转换/一维表转二维表/二维表转一维表

本文于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~~~~~~

喜欢就点个赞、点在看、留言评论、分享一下呗!感谢支持!

发表评论:

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。

«    2024年12月    »
1
2345678
9101112131415
16171819202122
23242526272829
3031
控制面板
您好,欢迎到访网站!
  查看权限
网站分类
搜索
最新留言
    文章归档
      友情链接