[已解决]高手路过别错过，富有挑战性的VBA，来试试吧

zhycl

根据两个单元格数值取符合要求的工作表名放到对应的单元格，详见附件 工作簿1.rar (16.4 KB, 下载次数: 13)

2017-6-12 17:30 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

七彩屋

2017-6-12 18:22

1. Sub qcw()
   
2. Dim arr, i, j, k, r
   
3. r = Range("a65536").End(xlUp).Row
   
4. Range("b2:d" & r).ClearContents
   
5. For k = 2 To r
   
6.   For i = 2 To 4
   
7.     For j = 1 To Sheets.Count
   
8.        If InStr(Sheets(j).Name, Cells(k, 1)) > 0 And InStr(Sheets(j).Name, Cells(1, i)) > 0 Then
   
9.          Cells(k, i) = Sheets(j).Name
   
10.        End If
    
11.     Next j
    
12.   Next i
    
13. Next k
    
14. End Sub
    

复制代码

跳转到最佳答案楼层

pengyx

前面三个单元格值（B2/C2/D2)，用作判断工作表名中是否包含此字符。?是（b1/c1/d1）,还是（B2/C2/D2)????.不过无论是什么都没有挑战性

七彩屋

1. Sub qcw()
   
2. Dim arr, i, j, k, r
   
3. r = Range("a65536").End(xlUp).Row
   
4. Range("b2:d" & r).ClearContents
   
5. For k = 2 To r
   
6.   For i = 2 To 4
   
7.     For j = 1 To Sheets.Count
   
8.        If InStr(Sheets(j).Name, Cells(k, 1)) > 0 And InStr(Sheets(j).Name, Cells(1, i)) > 0 Then
   
9.          Cells(k, i) = Sheets(j).Name
   
10.        End If
    
11.     Next j
    
12.   Next i
    
13. Next k
    
14. End Sub
    

复制代码

七彩屋

没有挑战性，数量大用数组

zhycl

七彩屋 发表于 2017-6-12 18:22

首先非常感谢您的帮助，不知能否设置成  根据工作表 删减、新增情况，自动变换工作表名呢？[em27]

七彩屋

在首页工作表加代码
Private Sub Worksheet_Activate()
Call qcw
End Sub