请教如何自动匹配数据到各工作表

天涯887

复制"空白"工作表且依据场地号命名 并把淘汰赛的数据匹配进去

需求： 自动生成1 2 3  4 5、、、18、19、20的工作表 并把淘汰赛的数据匹配进去
现实中非常有用 请教各位了

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim ws As Worksheet
   
4.     Dim arr, brr
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     For Each ws In Worksheets
   
8.         If ws.Name Like "#*" Then
   
9.             ws.Delete
   
10.         End If
    
11.     Next
    
12.     With Worksheets("淘汰赛")
    
13.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
14.         c = .Cells(3, .Columns.Count).End(xlToLeft).Column
    
15.         arr = .Range("a3").Resize(r - 2, c)
    
16.     End With
    
17.    
    
18.     For i = 2 To UBound(arr) Step 2
    
19.         For j = 4 To UBound(arr, 2) Step 3
    
20.             If Len(arr(i, j + 2)) <> 0 Then
    
21.                 Worksheets("空白").Copy after:=Worksheets(Worksheets.Count)
    
22.                 With ActiveSheet
    
23.                     .Name = CStr(arr(i, j + 2))
    
24.                     .Range("ak3") = arr(i, j + 2)
    
25.                     .Range("ao3") = arr(1, j)
    
26.                     .Range("c5") = arr(1, j + 1)
    
27.                     .Range("l5") = arr(i, j)
    
28.                     .Range("x5") = arr(i + 1, j)
    
29.                     .Range("l6") = arr(i, j + 1)
    
30.                     .Range("x6") = arr(i + 1, j + 1)
    
31.                     .Range("l7") = arr(i, 3)
    
32.                     .Range("x7") = arr(i + 1, 3)
    
33.                     .Range("o40") = arr(i + 1, j + 2)
    
34.                 End With
    
35.             End If
    
36.         Next
    
37.     Next
    
38.                
    
39. End Sub
    

复制代码

chxw68

详见附件。

chxw68

上面代码漏了2个单元格。

天涯887

chxw68 发表于 2024-9-5 11:17
详见附件。

哇 你真是牛 速度这么快 代码又这么简洁 不得不佩服
暂时没发现有什么问题 下午再检查下  感谢大神出手

天涯887

chxw68 发表于 2024-9-5 11:19
上面代码漏了2个单元格。

大神 漏了一个地方
左边那几列的名字没有出来 还请完善下 再次感谢

chxw68

把这么重要的内容忘了！！！

天涯887

chxw68 发表于 2024-9-5 12:31
把这么重要的内容忘了！！！

有一点点小问题 两队的名字要错开放
如图这样 你看好不好改

chxw68

修改好了。

天涯887

chxw68 发表于 2024-9-5 14:42
修改好了。

完美 beautiful 撒花