| Вопрос: Подскажите, VBA | Добавлено: 13.10.06 12:13 |
Автор вопроса:  Николай_05
|
| Здравствуйте. Как с помощью vba сделать процедуру поиска первого непустого значения в столбце "D", и взятие его в столбец "F" . Например: в "D3" пусто, "смотрим" в "D4"- пусто, "смотрим" в "D5" и т.д. до тех пор пока не будет значения, а если нет вообще значения, то берем сегодняшнюю дату (ф-ия TODAY). Допустим есть значения в "D20" - 10.03.2006, "D35" - 23.05.2006 и в "D100" - 13.11.2006, тогда в столбце "F" должно отображаться соответственно на этих интервалах:"F1" : "F20" - 10.03.2006, "F21" : "F35" - 23.05.2006, "F36" :"F100" - 13.11.2006 и дальше во всех "F" после "100" -сегодняшняя дата (т.к. после "D100" нет никаких данных до "D65535") |
| Ответы | Всего ответов: 8 |
|
Номер ответа: 1 Автор ответа:  angrynews Вопросов: 33 Ответов: 119 |
Web-сайт: Профиль | | #1 | Добавлено: 13.10.06 15:32 |
| тут на последних не больше 3-х страниц глянь, там два примера были | ||
|
Номер ответа: 2 Автор ответа: _ICE_ICQ: 354-671-214 Вопросов: 18 Ответов: 103 |
Профиль | | #2 | Добавлено: 13.10.06 15:56 |
|
В стандартной книге Excel 65000 строк. Ты все проверить собрался? Если нет то установи переменную MaxRn = Максимальный номер строки, после которого искать уже не будешь. Если да - сочуствую, работать оно будет достаточно долго. Лучше всего сделай еще вот что: перед этой операцией создай временный лист (ActiveWorkBook.Sheets.Add), Перейди в него, выполни операцию для теперь скрытого листа (для этого везде перед командами обращения к листу (например Range) Подставь Sheets(номер листа).
Private Rn() As String Private RnC as Long Sub Test() Dim Z As Long Dim Z1 As Long For Z=1 to 65535 If Len(Range("  " & cstr(Z)).Text)>0 Then
RnC = RnC + 1 If RnC=1 Then Redim Preserve Rn(RnC, 2) Rn(Rnc,1) = 1 Rn(Rnc,2) = Range(" " & Cstr(Z)).Text
RnC = RnC+1 End If Redim Preserve Rn(RnC, 2) Rn(Rnc,1) = Z Rn(Rnc,2) = Range(" " & Cstr(Z)).Text
End IF Next Rnc=Rnc+1 Redim Preserve Rn(RnC, 2) Rn(Rnc,1) = 65535 Rn(Rnc,2) = Date$ For Z=2 To RnC For Z1=Val(Rn(Z-1,1)) To Val(Rn(Z,1)) Range("F" & Cstr(Z1)).Text = Rn(Z,2) Next Next End Sub Не Тестировал, написал прямо в броузере могут быть баги, но смысл ты должен понять. |
||
|
Номер ответа: 3 Автор ответа: _ICE_ICQ: 354-671-214 Вопросов: 18 Ответов: 103 |
Профиль | | #3 | Добавлено: 13.10.06 16:00 |
| Не помню, в динамических массивах нельзя менять какую-то размерность, то-ли первую, то-ли последнюю. Если будет ругаться на Редимах, то нужно сделать вот что: во всех обращениях к массиву, в том числе в редимах, поменять местами значения размерностей, например Rn(Rnc,2) поменяй на Rn(2,Rnc) и т.д. | ||
|
Номер ответа: 4 Автор ответа: GenyaAВопросов: 0 Ответов: 185 |
Web-сайт: Профиль | | #4 | Добавлено: 13.10.06 16:00 |
|
Вот что у меня получилось:
Sub kkk()
'вызов процедуры 'аргументы - исходный столбец, столбец вставки, выражение для заполения "до конца" (может быть формулой /Local/ или значением) Call SpreadValuesUP(ActiveSheet.Columns(" " , ActiveSheet.Columns("F", "=СЕГОДНЯ()"
End Sub Sub SpreadValuesUP(FromCol As Range, ToCol As Range, Fil As Variant) 'процедура размножит содержимое исходного столбца в столбец вставки так, чтобы вместо пустых ячеек 'исходного вставлялось содержимое ближайшей внизу непустой ячейки исходного или, 'если больше значений в исходном нет, то выраженим "для заполнения" Fil до границы указанной 'области в FromCol ' Dim cc As Range Dim nx As Long, px As Long, i As Long nx = 1 'заменить на 2, если заголовки ненужно трогать px = nx - 1 If FromCol.Cells(nx, 1).Value <> Empty Then ToCol.Cells(nx, 1) = FromCol.Cells(nx, 1) px = nx End If Do While nx < FromCol.Parent.Rows.Count px = px + 1 If FromCol.Cells(nx + 1, 1).Value = Empty Then nx = FromCol.Cells(nx, 1).End(xlDown).Row Else nx = nx + 1 End If ToCol.Cells(px, 1).FormulaLocal = IIf(nx < FromCol.Parent.Rows.Count, FromCol.Cells(nx, 1), Fil) With ToCol.Cells(px, 1) .Copy Destination:=.Resize(nx - px + 1, 1) End With px = nx Loop End Sub попробуйте. |
||
|
Номер ответа: 5 Автор ответа: _ICE_ICQ: 354-671-214 Вопросов: 18 Ответов: 103 |
Профиль | | #5 | Добавлено: 13.10.06 16:01 |
| Сорри, и насчет MaxRn - Я ее так никуда и не приткнул. Сам придумаешь куда, если нужно. | ||
|
Номер ответа: 6 Автор ответа: Николай_05 Вопросов: 1 Ответов: 1 |
Профиль | | #6 | Добавлено: 16.10.06 10:46 |
|
Спасибо что откликнулись, навели на верную мысль. Я сделал так:
Function GetNextVAl(Col)
Rec = ActiveCell.Row Do Res = Cells(Rec, Col) Rec = Rec + 1 Loop Until (Res > "" Or (Rec > 10000)
If Not (Res > "" Then Res = Date
GetNextVAl = Res End Function Эту функцию вставил в модуль VBA, и при составлении формулы в excel вставляю ее как определенную пользователем например: =(GetNextVAl(6)-C2)*A2*B2/100 Еще раз всем спасибо. |
||
|
Номер ответа: 7 Автор ответа: angrynewsВопросов: 33 Ответов: 119 |
Web-сайт: Профиль | | #7 | Добавлено: 17.10.06 12:35 |
| вот это понаписали кода!!! Какие-то сложные условия.. | ||
|
Номер ответа: 8 Автор ответа: GenyaAВопросов: 0 Ответов: 185 |
Web-сайт: Профиль | | #8 | Добавлено: 17.10.06 12:54 |
|
Если бы условия "как с помощью vba" не было поставлено, можно было бы и намного проще, одной формулой...
|
||
Страница: 1 |