Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Не работает связка If Not foundCell Is Nothing Then
 
Доброго времени суток!  
Нужно чтобы выполнялось следующее условие:  
 
Sub FDAC1()  
 
Dim r As Range  
Dim foundCell As Range  
 
datarez = Range("A1")  
MsgBox datarez  
   
Set r = Worksheets("Лист1").Range("B1:N1")  
Set foundCell = r.Find(datarez, LookIn:=xlValues)  
 
If Not foundCell Is Nothing Then  
MsgBox "it is working"  
         
Else  
MsgBox "it is not working"  
End If  
 
End Sub  
 
Если вводить в поиск дату 12.10.2010 (из диапазона, где данная дата присутствует), то условие идёт на else. Если же водить дату до 09.10.2010 алгоритм выходит на then.    
 
Почему так происходит и как исправить. Голову сломал! Пример в файлике...
проблема с пересчетом формулы
 
Решил проблему следующим образом:  
 
Public Function SumColumn(nSTRn As Integer, step As Integer)  
Application.Volatile True  
On Error GoTo errorHandler  
Dim SubSum As Double  
quantityday = Worksheets("EDIT").Range("C9").Value  
For i = 1 To quantityday  
SheetName = Application.Caller.Worksheet.Name  
SubSum = SubSum + Sheets(SheetName).Cells(nSTRn, Application.Caller.Column).Value  
nSTRn = nSTRn + step  
TypeMismatch:  
Next i  
SumColumn = SubSum  
errorHandler:  
   If Err = 13 Then Resume TypeMismatch  
End Function  
 
SheetName = Application.Caller.Worksheet.Name - добавил вот это.  
Т.е. при  пересчете формулы брались значения с активного листа, а не с того, где прописана функция.
проблема с пересчетом формулы
 
Опять же, работает некорректно. Если занести значения по ячейкам, то суммирование по функции даст верный результат. Но если не изменять значения а сделать WWW, то проблема остается... Т.е. остается проблема №2 (указывал выше). Итоговые значения фунцкии листа 1 переносятся на лист 2 и 3
проблема с пересчетом формулы
 
Доброго времени суток! Имеем книгу с тремя листами (1,2,3). По заданной функции нужно просуммировать значения со строки 33 с шагом 32, 31 раз (или менее, это кол-во дней).  
 
Проблема в следующем:  
1. Если изменять значения в строках - функция не пересчитывает сумму по столбцам.  
2. Если сделать принудительный перерасчет формул Shift+Ctrl+Alt+F9, то функция пересчитается на активном листе (например на листе 1), при этом итогом расчета функции на листах  2 и 3 будут значения с листа 1.    
 
Нужно чтобы формула пересчитывалась, например если как использовать функцию СУММ.
Функция. Преобразование формата ячейки
 
Доброго времени суток! Смысл нижеследующей функции: имеется ячейка тип данных  string в формате yyyymmdd, функция преобразует(должна :) ) тип данных в дату в формат dd.mm.yyyy. В итоге получаю в ячейке на подобие "40379". Как преобразовать формат ячейки в дату?  
 
Function dateG(datarange As String) As Date  
Dim yearG As String  
Dim mounthG As String  
Dim dayG As String  
 
yearG = Mid(datarange, 1, 4)  
mounthG = Mid(datarange, 5, 2)  
dayG = Mid(datarange, 7, 2)  
dateG = dayG & "/" & mounthG & "/" & yearG  
 
End Function
Получение имени открытой книги
 
Структура:  
workbooks(iFileName).close True'если сохранять не надо - False  
не работает, т.к. имя открытой книги (в которой открылся xml) не соответствует имени xml файла. Доперло до меня.. заменил вот так:  
 
Sub Test()  
 
With Application.FileDialog(msoFileDialogFolderPicker)  
.InitialFileName = Application.DefaultFilePath & "/"  
.Title = "Укажите папку с файлами"  
If .Show = False Then Exit Sub  
Folder = .SelectedItems.Item(1)  
End With  
 
Application.ScreenUpdating = False  
'MsgBox Folder  
Dim PathPrice$, iFileName$, iCount&  
PathPrice = Folder  
'MsgBox PathPrice  
 
If Right(PathPrice, 1) <> "\" Then PathPrice = PathPrice & "\"  
If Dir(PathPrice, vbDirectory) = "" Then  
MsgBox "Файлов не найдено": Exit Sub  
End If  
 
iFileName = Dir(PathPrice & "*.xml")  
Do While iFileName <> ""  
iCount = iCount + 1  
Workbooks.OpenXML Filename:=PathPrice & iFileName, LoadOption:=xlXmlLoadImportToList  
bn = ActiveWorkbook.Name  
MsgBox bn  
 
If Range("I2") = "3800000901" Then  
Range("A1:R30625").Copy ThisWorkbook.Sheets("1").Range("A1")  
Workbooks(bn).Close False 'если сохранять не надо - False  
iFileName = Dir  
 
Else  
 
If Range("I2") = "3800000905" Then  
Range("A1:R1633").Copy ThisWorkbook.Sheets("2").Range("A1")  
MsgBox bn & "второе условие"  
Workbooks(bn).Close False 'если сохранять не надо - False  
iFileName = Dir  
Else: Exit Sub  
 
End If  
End If  
 
Loop  
If iCount = 0 Then MsgBox "упс!", 64, ""  
Application.ScreenUpdating = True  
End Sub  
 
 
За оптимизацию большое спасибо!!!
Получение имени открытой книги
 
извините, почему то не весь код влез. Код в приложении.
Получение имени открытой книги
 
вводная:  
 
Есть некоторый файл с расширением xml, его необходимо открыть в excel и скопировать часть диапазона в определенную книгу, на определенный лист. После этого закрыть xml файл, открытый в excel. Для этого требуется получить имя открытой книги (xml файл), с этим проблемы, делаю так:  
 
1. Workbooks.OpenXML Filename:=PathPrice & iFileName, LoadOption:=xlXmlLoadImportToList  
 
Имя открытой книги - "Книга1", "Книга2" и т.п.. Открывать надо именно в этом формате.    
 
 
Sub Test()  
 
   
     
  With Application.FileDialog(msoFileDialogFolderPicker)  
   .InitialFileName = Application.DefaultFilePath & "/"  
   .Title = "Укажите папку с файлом"  
   .Show  
       If .SelectedItems.Count = 0 Then  
       MsgBox "Файлов не найдено"  
       exit sub  
       Else: Folder = .SelectedItems.Item(1)  
       End If  
 End With  
         
     
'MsgBox Folder  
Dim PathPrice$, iFileName$, iCount&  
PathPrice = Folder  
'MsgBox PathPrice  
 
If Right(PathPrice, 1) <> "\" Then PathPrice = PathPrice & "\"  
If Dir(PathPrice, vbDirectory) = "" Then  
Exit Sub  
End If
Страницы: 1
Наверх