[已解决]签名的问题,有点麻烦.希望高手能解出来.多谢了.

跑跑2014

不知道这个签名的问题难度如何,请教高手,多谢了.

最佳答案

月排行榜 / 总排行榜

cbg2008

2014-6-25 20:15

1. Sub 加分页符八()
   
2.     Dim strSearch As String
   
3.     Application.ScreenUpdating = False
   
4.     Sheet110.ResetAllPageBreaks
   
5.     Dim i As Integer
   
6.     For i = 2 To Range("D65536").End(3).Row
   
7.         If Sheet110.Cells(i, 4).Value Like ("制表：*") Then
   
8.             Sheet110.HPageBreaks.Add Before:=Sheet110.Cells(i + 1, 1)
   
9.             strSearch = Sheet110.Range("D1:D" & i).Find(what:="承租单位:", after:=Sheet110.Range("D" & i), SearchDirection:=xlPrevious, lookat:=xlPart).Value
   
10.             strSearch = Mid(strSearch, 6, WorksheetFunction.Max(InStrRev(" ", strSearch) - 5, 4))
    
11.             Sheet110.Range("F" & i) = Sheet5.Range("AB2:AB" & Sheet5.Cells(Rows.Count, "AB").End(3).Row).Find(what:=strSearch, lookat:=xlWhole).Offset(0, 3).Value
    
12.         End If
    
13.     Next
    
14.     Application.ScreenUpdating = True
    
15. End Sub
    

复制代码

签名的问题.rar (101.18 KB, 下载次数: 5)

2014-6-25 20:14 上传

点击文件名下载附件

跳转到最佳答案楼层

cbg2008

1. Sub 加分页符八()
   
2.     Dim strSearch As String
   
3.     Application.ScreenUpdating = False
   
4.     Sheet110.ResetAllPageBreaks
   
5.     Dim i As Integer
   
6.     For i = 2 To Range("D65536").End(3).Row
   
7.         If Sheet110.Cells(i, 4).Value Like ("制表：*") Then
   
8.             Sheet110.HPageBreaks.Add Before:=Sheet110.Cells(i + 1, 1)
   
9.             strSearch = Sheet110.Range("D1:D" & i).Find(what:="承租单位:", after:=Sheet110.Range("D" & i), SearchDirection:=xlPrevious, lookat:=xlPart).Value
   
10.             strSearch = Mid(strSearch, 6, WorksheetFunction.Max(InStrRev(" ", strSearch) - 5, 4))
    
11.             Sheet110.Range("F" & i) = Sheet5.Range("AB2:AB" & Sheet5.Cells(Rows.Count, "AB").End(3).Row).Find(what:=strSearch, lookat:=xlWhole).Offset(0, 3).Value
    
12.         End If
    
13.     Next
    
14.     Application.ScreenUpdating = True
    
15. End Sub
    

复制代码

签名的问题.rar (101.18 KB, 下载次数: 5)

2014-6-25 20:14 上传

点击文件名下载附件

跑跑2014

cbg2008 发表于 2014-6-25 20:15

非常感谢,是我想要的部分效果.还有一点,不好意思,我给解释错误了,就是"审核：加上名字,后面的     ""                承租方签收人：                        承租方负责人："  还要保留.这个还能加进去吗.  这个需要承租方签字.  

cbg2008

跑跑2014 发表于 2014-6-25 20:45
非常感谢,是我想要的部分效果.还有一点,不好意思,我给解释错误了,就是"审核：加上名字,后面的     ""   ...

可以，等等，我改一下代码

cbg2008

跑跑2014 发表于 2014-6-25 20:45
非常感谢,是我想要的部分效果.还有一点,不好意思,我给解释错误了,就是"审核：加上名字,后面的     ""   ...

1. Sub 加分页符八()
   
2.     Dim strSearch As String
   
3.     Dim strName As String
   
4.     Dim strQianMing As String
   
5.     Application.ScreenUpdating = False
   
6.     Sheet110.ResetAllPageBreaks
   
7.     Dim i As Integer
   
8.     For i = 2 To Range("D65536").End(3).Row
   
9.         If Sheet110.Cells(i, 4).Value Like ("制表：*") Then
   
10.             Sheet110.HPageBreaks.Add Before:=Sheet110.Cells(i + 1, 1)
    
11.             strSearch = Sheet110.Range("D1:D" & i).Find(what:="承租单位:", after:=Sheet110.Range("D" & i), SearchDirection:=xlPrevious, lookat:=xlPart).Value
    
12.             strSearch = Mid(strSearch, 6, WorksheetFunction.Max(InStrRev(" ", strSearch) - 5, 4))
    
13.             strName = Sheet5.Range("AB2:AB" & Sheet5.Cells(Rows.Count, "AB").End(3).Row).Find(what:=strSearch, lookat:=xlWhole).Offset(0, 3).Value
    
14.             strQianMing = Sheet110.Range("D" & i)
    
15.             strQianMing = WorksheetFunction.Replace(strQianMing, InStr(strQianMing, "审核：") + 6, 4, strName)
    
16.             Sheet110.Range("D" & i) = strQianMing
    
17.         End If
    
18.     Next
    
19.     Application.ScreenUpdating = True
    
20. End Sub

复制代码

跑跑2014

cbg2008 发表于 2014-6-25 21:16

我在您第一段代码下面
加了 Sheet110.Range("k" & i) = "承租方签收人："
          Sheet110.Range("q" & i) = "承租方负责人："

非常感谢,效果完全是我想要的..