Открытая функция ScanColumns (SheetName As String, thisMany как Double, ShowWhat As String)
e = 0
For a = 1 To thisMany
aa = Application.WorksheetFunction.CountA(Sheets(SheetName).Cells(1, a).EntireColumn)
If aa > 0 Then
r = a
If e = 0 Then
e = a
End If
End If
Next a
If ShowWhat = "MIN" Then
ScanColumns = e
End If
If ShowWhat = "MAX" Then
ScanColumns = r
End If
End Function
Public Function ScanRows(SheetName As String, thisMany As Double, ShowWhat As String)
e = 0
For a = 1 To thisMany
aa = Application.WorksheetFunction.CountA(Sheets(SheetName).Cells(a, 1).EntireRow)
If aa > 0 Then
r = a
If e = 0 Then
e = a
End If
End If
Next a
If ShowWhat = "MIN" Then
ScanRows = e
End If
If ShowWhat = "MAX" Then
ScanRows = r
End If
End Function
Public Function FindInArea(SheetName As String, startRow As String, endRow As String, startCol As String, endCol As String, FindThis As String, ShowWhat As String)
CalendarMonthFormat1 = "Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec,"
CalendarMonthFormat2 = "January, Feburary,March,April,May,June,July,August,September,October,November,December,"
earliestDate = 999999999
latestDate = 0
If Left(FindThis, 7) = "[LENGTH" Then
LengthLook = Replace(FindThis, "[LENGTH", "")
LengthLook = Replace(LengthLook, "]", "")
End If
For a = startRow To endRow
For b = startCol To endCol
ThisCell = Sheets(SheetName).Cells(a, b)
thisCellAddr = Sheets(SheetName).Cells(a, b).Address
If ThisCell = FindThis Then
addrList = addrList & "[" & thisCellAddr & "]"
rc_list = rc_list & "[" & a & "," & b & "]"
c = c + 1
End If
If FindThis = "[MONTHS1]" Then
If ThisCell <> "" And InStr(LCase(CalendarMonthFormat1), LCase((ThisCell) & ",")) > 0 And Len(ThisCell) = 3 Then
addrList = addrList & "[" & thisCellAddr & "]"
rc_list = rc_list & "[" & a & "," & b & "]"
c = c + 1
End If
End If
If FindThis = "[MONTHS2]" Then
If ThisCell <> "" And InStr(LCase(CalendarMonthFormat2), LCase((ThisCell) & ",")) > 0 Then
addrList = addrList & "[" & thisCellAddr & "]"
rc_list = rc_list & "[" & a & "," & b & "]"
c = c + 1
End If
End If
If FindThis = "[DATEFORMAT]" Then
If InStr(ThisCell, "/") > 0 Then
slash_count = 0
For sc = 1 To Len(ThisCell)
If Mid(ThisCell, sc, 1) = "/" Then
slash_count = slash_count + 1
End If
Next sc
If slash_count = 2 Then
On Error Resume Next
D = Day(ThisCell)
M = Month(ThisCell)
Y = Year(ThisCell)
If D > 0 And M > 0 And Y > 0 Then
addrList = addrList & "[" & thisCellAddr & "]"
rc_list = rc_list & "[" & a & "," & b & "]"
c = c + 1
If earliestDate > DateValue(ThisCell) Then
earliestDate = DateValue(ThisCell)
If Len(D) = 1 Then
D = "0" & D
End If
If Len(M) = 1 Then
M = "0" & M
End If
eDateLocation = thisCellAddr
eDate_Format = D & "-" & M & "-" & Y
End If
If latestDate < DateValue(ThisCell) Then
latestDate = DateValue(ThisCell)
If Len(D) = 1 Then
D = "0" & D
End If
If Len(M) = 1 Then
M = "0" & M
End If
lDateLocation = thisCellAddr
lDate_Format = D & "-" & M & "-" & Y
End If
End If
End If
End If
End If
If Left(FindThis, 7) = "[LENGTH" Then
If Len(ThisCell) = Val(LengthLook) Then
addrList = addrList & "[" & thisCellAddr & "]"
rc_list = rc_list & "[" & a & "," & b & "]"
c = c + 1
End If
End If
If FindThis = "[DECIMAL]" Then
If InStr((ThisCell), ".") > 0 Then
addrList = addrList & "[" & thisCellAddr & "]"
rc_list = rc_list & "[" & a & "," & b & "]"
c = c + 1
End If
End If
If FindThis = "[PERC]" Then
If InStr((ThisCell), ".") > 0 And ThisCell <> "" And ThisCell <> 0 And Val(ThisCell) >= -1 And Val(ThisCell) <= 1 Then
addrList = addrList & "[" & thisCellAddr & "]"
rc_list = rc_list & "[" & a & "," & b & "]"
c = c + 1
End If
End If
Next b
Next a
If ShowWhat = "COUNT" Then
FindInArea = c
End If
If ShowWhat = "ADDR" Then
FindInArea = addrList
End If
If ShowWhat = "RC" Then
FindInArea = rc_list
End If
If ShowWhat = "EARLIESTDATE" Then
FindInArea = eDate_Format
End If
If ShowWhat = "EARLIESTDATEADDR" Then
FindInArea = eDateLocation
End If
If ShowWhat = "LATESTDATE" Then
FindInArea = lDate_Format
End If
If ShowWhat = "LATESTDATEADDR" Then
FindInArea = lDateLocation
End If
End Function