ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > 行业案例 > 生产管理 > 如何运用VBA完成库存货品不同尺码存货量汇总表的格式转换呢?

如何运用VBA完成库存货品不同尺码存货量汇总表的格式转换呢?

作者:绿色风 分类:生产管理 时间:2022-08-18 浏览:130
楼主
0Mouse
Q:如何运用VBA完成库存货品不同尺码存货量汇总表的格式转换呢?
示例:
转换前:

 
转换后:

 
注:服装尺码从XS开始,男鞋尺码从38开始,女鞋尺码从34开始。
A:代码如下:
  1. Sub 表格格式转换()
  2. Dim arr, brr(1 To 10000, 1 To 13), i%, j%, k%, x%
  3. arr = Range("A1:U" & Cells(Rows.Count, 1).End(xlUp).Row).Value
  4. For i = 4 To UBound(arr)
  5.     For j = 12 To 21
  6.         If Val(arr(i, j)) <> 0 Then
  7.             x = x + 1
  8.             If arr(i, 10) = "服装" Then
  9.                 brr(x, 12) = arr(1, j)
  10.             Else
  11.                 brr(x, 12) = IIf(arr(i, 11) = "女", arr(2, j), arr(3, j))
  12.             End If
  13.             brr(x, 13) = arr(i, j)
  14.             For k = 1 To 11
  15.                 brr(x, k) = arr(i, k)
  16.             Next
  17.         End If
  18.     Next
  19. Next
  20. With Sheet2
  21.     .Cells.Clear
  22.     .[A1:K1].Value = [A1:K1].Value
  23.     .[L1] = "尺码": .[M1] = "数量"
  24.     .[A2].Resize(x, 13) = brr
  25.     With .Range("A1").Resize(x + 1, 13).Borders
  26.         .LineStyle = xlContinuous
  27.         .Weight = xlThin
  28.     End With
  29. End With
  30. End Sub
附件:
运用VBA完成库存货品不同尺码存货量汇总表的格式转换.rar
2楼
xyf2210
学习
3楼
eliane_lei
跟着小千学习!谢谢分享!
4楼
LOGO
自己写了一段,后面将数组写入单元格的代码照搬了小千版主的代码

  1. Sub CH()
  2. Dim arr, crr()
  3. Dim r As Integer, c As Integer, r2 As Integer, i As Integer
  4. arr = Range("a1").CurrentRegion
  5. For r = 4 To UBound(arr)
  6.     For c = 12 To UBound(arr, 2)
  7.         If Val(arr(r, c)) <> 0 Then
  8.             i = i + 1
  9.             ReDim Preserve crr(1 To 13, 1 To i)
  10.                 For r2 = 1 To 11
  11.                     crr(r2, i) = arr(r, r2)
  12.                 Next
  13.                 crr(12, i) = arr(IIf(arr(r, 10) <> "服装", IIf(arr(r, 11) = "男", 3, 2), 1), c)
  14.                 crr(13, i) = arr(r, c)
  15.         End If
  16.     Next
  17. Next
  18. With Sheet2
  19.     .Cells.Clear
  20.     .[A1:K1].Value = [A1:K1].Value
  21.     .[L1] = "尺码": .[M1] = "数量"
  22.     .[A2].Resize(i, 13) = WorksheetFunction.Transpose(crr)
  23.     With .Range("A1").Resize(i + 1, 13).Borders
  24.         .LineStyle = xlContinuous
  25.         .Weight = xlThin
  26.     End With
  27. End With
  28. End Sub
5楼
lrlxxqxa

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap