» Excel VBA (часть 2)

SAS888
Но ведь это все равно будет гораздо медленнее, если использовать ReDim Preserve на каждом шаге. Чем могло бы быть

dneprcomp

Цитата:

Но ведь это все равно будет гораздо медленнее, если использовать ReDim Preserve на каждом шаге

Согласен. Смотря сколько этих шагов. Вариантов решения очень много. И какой из них наиболее рациональный, зависит от множества факторов.
Так, например, можно в цикле получить коллекцию уникальных значений, а затем, уже зная количество элементов, определить размерность массива и вторым циклом "загнать" в него коллекцию.

Помогите начинающему новичку пожалуйста, возникла проблема,
Есть столбец в excel с последовательностью + и -
-
-
+
-
-
-
+
+
+
Написал на VBA простой алгоритм который подсчитывает соответственно количество + и - в последовательности то есть такой результат выдает в соседней таблице
- 1
- 2
+ 1
- 1
- 2
- 3
+ 1
+ 2
+ 3
Помогите не как не могу понять, как дополнить алгоритм, чтобы в результате подсчета данные записывались таки образом
-
- 2
+ 1
-
-
- 3
+
+
+ 3
Т.е пропускались промежуточные вычисления и выводился только результат , а то приходится в ручную убирать лишнее

While (a = True)
If ActiveCell.Value = "+" Then
Set c = Range(ActiveCell.Address)
c.Select
flag = True
mn = 0
pl = pl + 1
Range("P1").Value = gpl
ActiveCell.Offset(0, 1).Value = pl
End If
If ActiveCell.Value = "-" Then
flag = False
pl = 0
mn = mn + 1
ActiveCell.Offset(0, 1).Value = mn
End If
If ActiveCell.Value = "" Then a = False
Wend

SAS888

Цитата:

Так, например, можно в цикле получить коллекцию уникальных значений, а затем, уже зная количество элементов, определить размерность массива и вторым циклом "загнать" в него коллекцию.

А вот это решение и будет скорее всего оптимальным

babiych
Выделите требуемый диапазон в столбце (где находятся "+" и "-") и выполните макрос:

Код: Sub Num()
Dim i As Long, Cell As Range: Application.ScreenUpdating = False: i = 1
For Each Cell In Selection
If Cell = Cell.Offset(1) Then
i = i + 1
Else: Cell.Next = i: i = 1
End If
Next
End Sub

Добрый день!

Help, please

ОЧЕНЬ нужно решить задачку по подсчету количества определенного символа. В качестве функции этот код работает, т.е. выделив диалазон запускаю функцию, через InputBox говорю что искать и в MsgBox вывожу результат. Все здорово.
Но телерь понадобилось сделать процедуру, чтобы можно было в какой-нибудь ячейке Excel написать формулу вроде такой:

=CharCountParam("a",a1:b5)

и в получить количество букв "а" в этом диапазоне. Но в ячейке пишется #ЗНАЧЕН!
Думаю что я не корректно использую Range, но не могу понять что именно не так. HELP!

----------------------------------------------------------------------------------------
Public Function CharCountParam(Fchar As String, Rng As Range) As Long

Dim lngPosition, lngStartPosition, lngCount, TotalCount As Long
Dim rCell As Range

If Fchar = "" Then End

TotalCount = 0
lngPosition = 0 - Len(Fchar)
lngCount = -1

For Each rCell In Rng
Do
lngPosition = InStr(lngPosition + Len(Fchar), rCell, Fchar)
lngCount = lngCount + 1
Loop Until lngPosition = 0
TotalCount = TotalCount + lngCount
lngCount = -1
lngPosition = 0 - Len(Fchar)
Next rCell

CharCountParam = TotalCount

End Function
------------------------------------------------------------------------------------------

LukeMurmansk
Можно проще:

Код: Function CharCountParam(txt As String, rng As Range) As Long
For Each Cell In rng
If Cell <> "" Then CharCountParam = CharCountParam + UBound(Split(Cell, txt))
Next
End Function

SAS888

Сильно!
Спасибо!

помогите разобраться в задаче...Метод координатного спуска..Ее надо на VBA написать и что б еще и график выводил

SAS888 - Огромный респект!!!! очень помогли! долго себе голову ломал...

а подскажите, как в комбо назначить ItemData ?
У меня есть данные:
1, Саша
5, Петя
8, Коля
в ВБ6.0 я делал так:

Код: .AddItem "Саша"
.ItemData(cmbShops.newIndex) = 1
.AddItem "Петя"
.ItemData(cmbShops.newIndex) = 5
.AddItem "Коля"
.ItemData(cmbShops.newIndex) = 8

Уважаемые, помогите пожалуйста упростить задачу если это возможно.

Код: Option Base 1
Sub test()
Dim x(1 To 100) 'массив

For i = 1 To 100
x(i) = Sheets(1).Cells(i, 1).Value 'вношу значения диапазона Range("A1:A100") в массив x(1 To 100)
Next i

jurris
Во-первых, получить массив данных из диапазона "A1:A100" листа Sheets(1) можно существенно проще, без всяких циклов:

Код: Sub test()
x = Sheets(1).[A1:A100].Value
End Sub

Задача:
Имеется 41 число, из этих чисел нужно наити такие числа, сумма которых будет составлять определенное, нам известное число.

SAS888,
Вообще-то я мог бы использовать сами x(1, 1), x(2, 1), x(3, 1) ... x(100, 1) вместо переменных. Но тогда полностью теряется удобочитаемость скрипта и становится непонятно что и где, ведь там около сотни переменных с входного массива, а кроме того еще в процессе обработки новые появляются... А скрипт достаточно обьемный.
Скрипт работает. Но просто хотелось бы немного упростить процес ввода опытных данных. Чтобы не приходилось вручную для новых опытов прописывать все 100 переменных, а одним новым массивом например.

Всем привет!
Кто знает почему при сохранени книги методом
ActiveWorkbook.SaveAs (bookname), FileFormat:=xlNormal
при использовании цикла, во время которого происходит сохранение порядка 100 книг, примерно 10 из них сохраняются без расширения .xls, с остальные сохраняются нормально ? Кто подскажет ? Заранее спасибо!


Добавлено:
Joshya
У меня была похожая задача, только значения суммы этих чисел должны были попасть в диапазон, вместо того что-бы равняться одному числу. Посмотрите здесь:
http://www.sql.ru/forum/actualthread.aspx?tid=657473
Если что неясно, спрашивайте.

Что-то никто ничего ...

SAS888
Вы наверное уже профи в VBA. Вот это классно: x = Sheets(1).[A1:A100].Value, а я все время через циклы ... А Вы еще пишете на чем нибудь кроме VBA и VB наверное ?...

MaximuS G

Цитата:

примерно 10 из них сохраняются без расширения .xls

Эти "примерно 10" книг имеют какую-нибудь особенность? Например, определенные знаки (точки и т.п.) в имени. Или они случайны?
При формировании строковой переменной "bookname", Вы добавляете к имени файла расширение ( & ".xls")?

P.S. Начинал на VB. Сейчас только VBA. (Для личных сообщений используйте "личный ящик".)

Народ оч прошу помогите мне оч срочно..


Создать произвольную квадратную матрицу, доказать что она ортонометрическа.

SAS888

Цитата:

Эти "примерно 10" книг имеют какую-нибудь особенность? Например, определенные знаки (точки и т.п.) в имени. Или они случайны?
При формировании строковой переменной "bookname", Вы добавляете к имени файла расширение ( & ".xls")?

Они случайны... ".xls" не добавлял, так как ставил тип сохраняемого файла FileFormat:=xlNormal... добавил - теперь все нормально.
Спасибо большое!

Цитата:

Для личных сообщений используйте "личный ящик".)

ОК

Подскажете пожалуйста как можно проделать следующее.
Выполнить проверку в Книге на наличие Листа с каким-то определенным названием, например "MAIN".
Если такого нет, то создать worksheet("MAIN"), а если есть, тогда продолжить дальше.
Вроде просто, но я уже день сижу не врублюсь что не так делаю. Постоянно ошибка.
Вообще то как правильно выполнить проверку на наличие именно worksheet("MAIN") в Книге, если кратко.

Буду очень признателен.

jurris

Dim sh As Worksheet, bFound As Boolean
bFound = False
For Each sh In Sheets
If sh.Name = "MAIN" Then
bFound = True
Exit For
End If
Next
If bFound Then MsgBox "А вот он!"

jurris

Цитата:

Если такого нет, то создать worksheet("MAIN"), а если есть, тогда продолжить дальше.

Можно проще. Без всяких циклов:

Код: Dim sh As Worksheet
On Error Resume Next: Set sh = Sheets("MAIN")
If Err <> 0 Then Sheets.Add.Name = "MAIN"
On Error GoTo 0

Xaoc666
SAS888
Большущее вам спасибо!

Всем привет!

Есть макросы, который обрабатывает данные в excel документе, передает результат в Word, а excel закрывает без сохранения

******************************************************
Sub scheta2() ЭТОТ МАКРОС ДЛЯ УАЗОВ
'
Dim sch, dv, kuz, vin As Variant
Dim i, j As Integer

i = 2
j = 3
sch = Worksheets(1).Cells(i, j)

While Worksheets(1).Cells(i, j) <> Empty

sch = "ш." & Worksheets(1).Cells(i, j)
Worksheets(1).Cells(i, j) = sch

kuz = "куз." & Worksheets(1).Cells(i, j + 1)
Worksheets(1).Cells(i, j + 1) = kuz

dv = "дв." & Worksheets(1).Cells(i, j + 2)
Worksheets(1).Cells(i, j + 2) = dv

vin = "VIN " & Worksheets(1).Cells(i, j + 3)
Worksheets(1).Cells(i, j + 3) = vin

Worksheets(1).Cells(i + 25, j - 1).Select
Worksheets(1).Cells(i + 25, j - 1) = sch & " " & dv & " " & kuz & " " & vin

i = i + 1
k = i - 2
Wend
x1 = i + 25 - k
y1 = i + 25 - 1
x = "B" & x1
y = "B" & y1

Worksheets(1).Range(x, y).Select
With Selection.Font
.Name = "Times New Roman"
.Size = 12
End With
Selection.Copy

With CreateObject("Word.Application")
.Documents.Add
.Selection.Paste ??????
.Visible = True
.Activate
End With

ActiveWorkbook.Close False
Excel.Application.Quit

End Sub
************************************************************

Sub scheta() ЭТОТ МАКРОС ДЛЯ ГАЗОВ
'
Dim sch, dv, kuz, vin, x, y As Variant
Dim f As Variant
Dim i, j, k, x1, y1 As Integer

i = 26
j = 3
sch = Worksheets(1).Cells(i, j)

While Worksheets(1).Cells(i, j) <> Empty

sch = "ш." & Worksheets(1).Cells(i, j)
Worksheets(1).Cells(i, j) = sch

dv = "дв." & Worksheets(1).Cells(i, j + 1)
Worksheets(1).Cells(i, j + 1) = dv

kuz = "куз." & Worksheets(1).Cells(i, j + 2)
Worksheets(1).Cells(i, j + 2) = kuz

vin = "VIN " & Worksheets(1).Cells(i, j + 3)
Worksheets(1).Cells(i, j + 3) = vin

Worksheets(1).Cells(i + 25, j - 1).Select
If sch = "ш.отсутствует" Then
Worksheets(1).Cells(i + 25, j - 1) = dv & " " & kuz & " " & vin
Else
Worksheets(1).Cells(i + 25, j - 1) = sch & " " & dv & " " & kuz & " " & vin
End If

i = i + 1
k = i - 26
Wend

x1 = i + 25 - k
y1 = i + 25 - 1
x = "B" & x1
y = "B" & y1

Worksheets(1).Range(x, y).Select
With Selection.Font
.Name = "Times New Roman"
.Size = 12
End With
Selection.Copy

With CreateObject("Word.Application")
.Documents.Add
.Selection.Paste
.Visible = True
.Activate
End With

ActiveWorkbook.Close False
Excel.Application.Quit

End Sub
*************************************************************************

На 6 машинах все нормально, а на 7-й останавливается на " .Selection.Paste"
Данные которые обрабатыаются - http://rapidshare.com/files/248514506/data.rar.html

filmax
а версии офиса одинаковые на 6-ти машинах по сравнению с 7-ой машиной? какие?

Есть и 2007, и 2003. Пошел к соседям - работает!
А на той что не работает - Word в памяти появляется, но макрос "как бы его не видит", поэтому paste и не срабатывает.
Удалил 2003 - поставил 2007. Проблема все равно осталась.

Добавлено:
заработала!

переставил Selection.Copy после создания объекта Word

With CreateObject("Word.Application")
Selection.Copy
.Documents.Add
.Selection.Paste
.Visible = True
.Activate
End With

Добавлено:
Я так понимаю. У меня не работал макрос, потому что на некоторых машинах word запускается с очищением буфера. И почему-то только на некоторых машинах.
Как это контролировать?

Доброго всем дня. Подскажите, пожалуйста, решение такой задачи.
На листе Excel есть таблица, в которой каждому месяцу года соответствуют 3 колонки
и еще 3 колонки - итоги с начала года. При открытии файла надо отобразить 3 колонки,
соответствующие выбранному месяцу, и 3 колонки итогов с начала года, а остальные
скрыть. С выбором месяца никаких трудностей (использовал MsgBox - работает),
а вот скрыть-отобразить нужные колонки не получается.
Кроме того, введенные данные надо сохранить в исходном файле и (при необходимости)
в файле под именем, связанным с выбранным месяцем. В исходном файле на листе
создал форму, связал ее с макросом. При нажатии этой CommandButton файл сохраняется под нужным именем, но сохраняется также форма (CommandButton) и макросы исходного файла, а это не нужно (в новом файле макросов не должно быть). Можно как-то это решить?
Заранее спасибо.

Может тебе надо не сохранять документ...
А сначала создать новый...
Потом вставит в него данные...
Потом сохранить документ...

Добрый день,
на листе создано несколько кнопок. Мне нужно выполнить для них всех одно действие. Подскажите как это можно сделать?
По идее должно быть как-то так:

Код: Dim ctl as control
For each ctl in ActiveWorkBook.ActiveSheet
...
Next