求老师帮助代码，谢谢！

cdnyrg

具体情况在附件，谢谢！

cdnyrg

朱荣兴 发表于 2019-12-3 15:58
这种问题，vba来解决是最佳方案

我也发了，目前未解决

liulang0808

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count <> 1 Then Exit Sub
   
3.     If Target.Row = 1 Then Exit Sub
   
4.     If Target.Column <> 1 Then Exit Sub
   
5.     If Len(Target) = 0 Then Exit Sub
   
6.     pth = ThisWorkbook.Path
   
7.     Application.EnableEvents = False
   
8.     fn = Dir(pth & "\学历" & Target.Value & ".*")
   
9.     If fn <> "" Then
   
10.         ActiveSheet.Hyperlinks.Add Anchor:=Target.Offset(0, 1), Address:=pth & "\学历" & fn, _
    
11.         TextToDisplay:=Target.Value
    
12.     End If
    
13.     fn = Dir(pth & "\聘书" & Target.Value & ".*")
    
14.     If fn <> "" Then
    
15.         ActiveSheet.Hyperlinks.Add Anchor:=Target.Offset(0, 2), Address:=pth & "\聘书" & fn, _
    
16.         TextToDisplay:=Target.Value
    
17.     End If
    
18.     Application.EnableEvents = True
    
19. End Sub

复制代码

liulang0808

附件内容供参考。。。。。。

cdnyrg

liulang0808 发表于 2019-12-4 20:31
附件内容供参考。。。。。。

老师，能否再修改下，有N行N列，有部分有文件的，没文件的显示为空值

liulang0808

cdnyrg 发表于 2019-12-5 10:33
老师，能否再修改下，有N行N列，有部分有文件的，没文件的显示为空值

没有明白楼主的N行N列是什么意思的

cdnyrg

liulang0808 发表于 2019-12-5 11:59
没有明白楼主的N行N列是什么意思的

老师，你能否帮我改一下，我只做聘书列，有文件显示为聘书，没文件的显示为空值。每运行一次都重新记录

liulang0808

    fn = Dir(pth & "\学历" & Target.Value & ".*")
    If fn <> "" Then
        ActiveSheet.Hyperlinks.Add Anchor:=Target.Offset(0, 1), Address:=pth & "\学历" & fn, _
        TextToDisplay:=Target.Value
    End If

这个是学历部分，删除，剩下仅有聘书了

liulang0808

1. Sub 按钮2_Click()
   
2. 
   
3.     arr = [a1].CurrentRegion
   
4.     pth = ThisWorkbook.Path
   
5.     Application.ScreenUpdating = False
   
6.     For j = 2 To UBound(arr)
   
7.         Cells(j, 2) = ""
   
8.         If Len(arr(j, 1)) > 0 Then
   
9.             fn = Dir(pth & "\聘书" & arr(j, 1) & ".*")
   
10.             If fn <> "" Then
    
11.                 ActiveSheet.Hyperlinks.Add Anchor:=Cells(j, 2), Address:=pth & "\聘书" & fn, _
    
12.                 TextToDisplay:=arr(j, 1)
    
13.             End If
    
14.         End If
    
15.     Next
    
16.     Application.ScreenUpdating = True
    
17. 
    
18. End Sub
    

复制代码