恳请大神帮忙看下转置的问题

hongmeili

麻烦大佬看下可否能够通过VBA来实现，不胜感激！！
将表1（拆分）转置成表2（条码），如果在条件允许的话，表2（条码）能否转置成表1（拆分）呢？

ykcbf1100

代码如下，供参考。。。

1. Sub ykcbf()  '//2024.2.1
   
2.     Dim arr, brr
   
3.     arr = Sheets("拆分").UsedRange
   
4.     ReDim brr(1 To 10000, 1 To 3)
   
5.     For i = 2 To UBound(arr)
   
6.         st = arr(i, 1)
   
7.         If st <> Empty Then
   
8.             n = 0
   
9.             For j = 2 To UBound(arr, 2) Step 3
   
10.                 If arr(i, j) <> Empty Then
    
11.                     n = n + 1
    
12.                     If n = 1 Then
    
13.                         m = m + 1
    
14.                         brr(m, 1) = st
    
15.                     End If
    
16.                     m = m + 1
    
17.                     brr(m, 1) = CStr(arr(i, j))
    
18.                     brr(m, 2) = arr(i, j + 1)
    
19.                     brr(m, 3) = arr(i, j + 2)
    
20.                 End If
    
21.             Next
    
22.         End If
    
23.     Next
    
24.     With Sheets("条形码")
    
25.         .UsedRange = ""
    
26.         .Columns(1).NumberFormatLocal = "@"
    
27.         .[a1].Resize(m, 3) = brr
    
28.         .[a1].Resize(m, 3).Borders.LineStyle = 1
    
29.     End With
    
30. End Sub
    
31. 
    

复制代码

cjc209

zhanglcn

1. Sub to_barcode()
   
2.     Dim wb As Workbook
   
3.     Dim ws_split, ws_barcode As Worksheet
   
4.     Dim lastRow As Long, lastColumn, nonEmptyCount, numGroups As Long
   
5.     Dim cell, rng As Range
   
6.     Dim arr(), brr() As Variant
   
7.    
   
8.     Set wb = ThisWorkbook
   
9.     Set ws_split = wb.Sheets("拆分")
   
10.     Set ws_barcode = wb.Sheets("条形码")
    
11.    
    
12.     lastRow = ws_split.Cells(ws_split.Rows.Count, 1).End(xlUp).Row
    
13.     lastColumn = ws_split.Cells(1, ws_split.Columns.Count).End(xlToLeft).Column
    
14.    
    
15.     Set rng = ws_split.Range(Cells(2, 1), Cells(lastRow, lastColumn))
    
16.    
    
17.     '计算使用区域内非空单元格数量
    
18.     nonEmptyCount = 0
    
19.     For Each cell In rng
    
20.         If Not IsEmpty(cell) Then
    
21.             nonEmptyCount = nonEmptyCount + 1
    
22.         End If
    
23.     Next cell
    
24.     '用非空单元格数量减去外箱码数量,再除以3算出有多少个条码
    
25.     numGroups = (nonEmptyCount - lastRow + 1) / 3
    
26.     '条码数加上外箱码算出第2个表中数据的行数
    
27.     rowBarcode = lastRow - 1 + numGroups
    
28.     '重定义数组brr用于存放拆分表处理后的数据
    
29.     ReDim brr(1 To rowBarcode, 1 To 3)
    
30.    
    
31.     '将拆分表中的数据部分赋值给数组arr
    
32.     'arr = ws_split.Range(Cells(2, 1), Cells(lastRow, lastColumn)).Value
    
33.     arr = rng.Value
    
34.    
    
35.     m = 0
    
36.     For i = LBound(arr, 1) To UBound(arr, 1)
    
37.         m = m + 1
    
38.         brr(m, 1) = Replace(arr(i, 1), "-", "--")
    
39.         For j = 2 To UBound(arr, 2) Step 3
    
40.             If arr(i, j) <> "" Then
    
41.                 m = m + 1
    
42.                 brr(m, 1) = arr(i, j)
    
43.                 brr(m, 2) = arr(i, j + 1)
    
44.                 brr(m, 3) = arr(i, j + 2)
    
45.             End If
    
46.         Next j
    
47.     Next i
    
48.    
    
49.     '将处理好的拆分表数据复制到条形码表
    
50.     ws_barcode.Cells.Clear
    
51.     ws_barcode.Range("A1").Resize(rowBarcode, 3) = brr
    
52.    
    
53.    
    
54.     '调整格式
    
55.     lastRow = ws_barcode.Cells(ws_barcode.Rows.Count, 1).End(xlUp).Row
    
56.     ws_barcode.Range(Cells(1, 1), Cells(lastRow, 3)).Font.Name = "微软雅黑"
    
57.     ws_barcode.Range(Cells(1, 1), Cells(lastRow, 3)).Font.Size = 12
    
58.     For i = 1 To lastRow
    
59.         If ws_barcode.Cells(i, 2).Value = "" Then
    
60.             ws_barcode.Range("A" & i).Font.Bold = True
    
61.         Else
    
62.             ws_barcode.Range("A" & i & ":C" & i).Borders.LineStyle = 1
    
63.             ws_barcode.Range("A" & i).NumberFormatLocal = "0_);[红色](0)"
    
64.         End If
    
65.         ws_barcode.Range("A" & i).HorizontalAlignment = xlHAlignLeft
    
66.         ws_barcode.Range("B" & i).HorizontalAlignment = xlHAlignLeft
    
67.         ws_barcode.Range("C" & i).HorizontalAlignment = xlHAlignCenter
    
68.     Next i
    
69. 
    
70. End Sub

复制代码

时间有限写了个从拆分表到条形码的

ykcbf1100

拆分，附件供参考

看不出还原有啥意义

hongmeili

ykcbf1100 发表于 2024-2-1 08:21
拆分，附件供参考

看不出还原有啥意义

十分感谢~

hongmeili

cjc209 发表于 2024-1-31 23:28

谢谢大佬

hongmeili

zhanglcn 发表于 2024-2-1 05:03
时间有限写了个从拆分表到条形码的

谢谢大佬

hongmeili

zhanglcn 发表于 2024-2-1 05:03
时间有限写了个从拆分表到条形码的

老师，如果有空的话还帮忙看下呢，就是我点击运行就弹出了这个了，需要怎么弄呢？

zhanglcn

hongmeili 发表于 2024-2-1 10:08
老师，如果有空的话还帮忙看下呢，就是我点击运行就弹出了这个了，需要怎么弄呢？

你把文件发上来