我有一个工作簿，可以从一个工作表中复制一系列单元格，然后根据日期将它们粘贴到第26行下面的另一个工作表上。
我试图在粘贴选区之前检查第5-25行中是否存在部分文本，以便我可以将其突出显示为特殊颜色。
以下子程序可以很好地绘制我想要的方式，但是当我尝试将函数checkValue2调用到FIND时，如果文本存在，它会运行一次然后停止。
我不确定我是否识别了太多范围或者FIND是否激活了错误的工作表。任何帮助将不胜感激
Sub buildGantt()
clearGantt
Dim fundingDate As Range
Dim SourceLastRow As Long
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet
Dim copyRange As Range
Dim sched As Worksheet
Dim startWeek As Date
Dim endWeek As Date
Dim Col_letter
Dim Col_letter2
Dim Col_letter3
Dim f As Range
Dim projRange As Range
Dim x As Integer
Dim Modality As String
Dim modColor As Long
On Error Resume Next
With Application
.ScreenUpdating = False
End With
Set sourceBook = ThisWorkbook
Set sourceSheet = sourceBook.Worksheets("Oz")
Set sched = ThisWorkbook.Sheets("Schedule")
'Determine last row of source from Oz which is the source worksheet
With sourceSheet
SourceLastRow = .Cells(.Rows.Count, "O").End(xlUp).Row
End With
'sorts sourcesheet based on Mech Start
sourceSheet.AutoFilterMode = False
For x = 2 To SourceLastRow
If sourceSheet.Range("L" & x).Value > (Now() - 21) Then 'L is install start
Modality = sourceSheet.Range("A" & x).Value
'MsgBox "what is in col A" & Modality
Select Case sourceSheet.Range("A" & x).Value
Case Is = "Holiday"
modColor = RGB(183, 222, 232)
Case Is = "PTO"
modColor = RGB(255, 153, 204)
Case Else
modColor = RGB(146, 208, 80)
End Select
Modality = ""
Set copyRange = sourceSheet.Range("G" & x & ":S" & x) 'the 12 columns to be copied
Set f = sched.Cells.Range("3:3").Find(sourceSheet.Range("L" & x).Value) 'finds install start
If Not f Is Nothing Then
Col_letter = Split(Cells(1, f.Column).Address(True, False), "$")(0)
Col_letter2 = Split(Cells(1, (f.Column + 12)).Address(True, False), "$")(0)
Col_letter3 = Split(Cells(1, (f.Column + 14)).Address(True, False), "$")(0)
'paste in sched
copyRange.Copy Destination:=sched.Range(Col_letter & (x + 40))
Set projRange = sched.Cells.Range(Col_letter & (x + 40) & ":" & Col_letter2 & (x + 40))
sched.Cells.Range(Col_letter3 & (x + 40)).Value = connectCells(projRange)
sched.Range(Col_letter & (x + 40)).Interior.Color = modColor
'this is the part that does not work properly
SOrder = sched.Cells.Range(Col_letter & (x + 40)) 'used to identify what will be searched for
columnL = Col_letter ' identifies what colum to search
MsgBox "returned value=" & checkValue2(SOrder, columnL) ' this works......but only allows it to run once
Else
'
End If
Set copyRange = Nothing
Set f = Nothing
Set Col_letter = Nothing
Set Col_letter2 = Nothing
Set Col_letter3 = Nothing
Else
'
End If
Next x
sched.AutoFilterMode = False
'Cells.AutoFilter
With Application
.ScreenUpdating = True
End With
End Sub
Function checkValue2(str As String, ColumnLetter As String) As String
Dim srchRng As Range
Dim status As String
'we only need to search in row 5 to 25
'we are looking for the SOrder as part of the test contained in the cells above where it will be pasted
With ThisWorkbook.Sheets("Schedule")
Set srchRng = .Range(ColumnLetter & "5:" & ColumnLetter & "25").Find(what:=str, _
LookIn:=xlValues, _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not srchRng Is Nothing Then
'MsgBox "SO found"
status = "green"
Else
'MsgBox "SO Not found"
status = "Red"
End If
End With
checkValue2 = status
End Function