» Excel VBA

xonix


Код:
Sub Copy_Cells()
LastRow1 = Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
LastRow2 = Worksheets("Sheet2").Cells.SpecialCells(xlCellTypeLastCell).Row

For Row1 = 1 To LastRow1
For Row2 = 1 To LastRow2
If (Worksheets("Sheet1").Cells(Row1, 1) = Worksheets("Sheet2").Cells(Row2, 1)) Then
Worksheets("Sheet1").Cells(Row1, 2) = Worksheets("Sheet2").Cells(Row2, 2)
End If
Next Row2
Next Row1
End Sub

LevT

Цитата:

По поводу хелпа в новых офисах хочется долго и матерно ругаться. Такое ощущение, что у них там великие реформы затянулись - да так, что никак не вернутся к уровню хелпа 97 офиса... С VBA-хелпом традиционно все еще хуже, чем в среднем по больнице.

Да уж.. Копаться в MSDN это не самый лучший хелп

aar

Цитата:

А что вызывает нарекания?

Отсутствие такового

А у кого как с performance в 2007-ом? Я, лично, уже все волосья себе на голове повыдёргивал от отчаяния. Приходится гонять доволино сложный макрос, с классами, динамическими charts и прочими наворотами. Так вот, на лаптопе с Pentium 1.6G 512mb стоит Excel 2003 и макро работает секунд 20-25, а на десктопе Pentium 2.53 1gb стоит Excel 2007 и тот же файл с тем же макросом идёт почти 3 минуты! О Б А Л Д Е ТЬ ! Особенно тормозят charts. Прямо, видно, как комп тужится.

И совместимости никакой.

У кого есть доступ к 2м версиям - 2007 и более ранними, протестируйте, плз, сей код и расскажите, что у вас получается


Цитата:

Sub AddChart()
Dim ch As ChartObject
Set ch = Worksheets("Sheet2").ChartObjects.Add(10, 10, 210,210)
With ch.Chart
.SetSourceData Source:=Sheets("Sheet1").Range("A1:C7"), PlotBy:=xlColumns
.ChartType = xl3DPie
With .SeriesCollection(1)
.XValues = Sheets("Sheet1").Range("A1:A7")
.ApplyDataLabels ShowPercentage:=True
End With

With .PlotArea
.Border.LineStyle = xlContinuous
.Interior.ColorIndex = 2
.Left = 50#
.Top = 25#
.Width = 160#
End With

With .ChartArea.Font
.Name = "Arial Narrow"
.FontStyle = "Regular"
.Size = 7
End With
End With
End Sub

Sheet1:
1101    Product1    $2,197.99
1102    Product2    $5,731.24
1103    Product3    $9,613.70
1104    Product4    $6,053.07
1105    Product5    $6,177.96
1106    Product6    $3,700.14
1107    Product7    $3,765.61

aar

Пасиб огромное !!! с меня виртуальное пиво

SERGE_BLIZNUK
а эта что то не заработала
колонки и строки постчитала а добавлять не хочет

vzbzdnov

Цитата:

У кого есть доступ к 2м версиям - 2007 и более ранними, протестируйте, плз, сей код и расскажите, что у вас получается

К 2007-ому доступа нет, но в Office XP на Duron 700 сей код отрабатывает моментально. Построение сотни этих круговых диаграмм в цикле занимает секунды две.

xonix
Цитата:

а эта что то не заработала
колонки и строки постчитала а добавлять не хочет

и не должна была!!! я же не Вам писал - это был пример кода для Stasssm
Это раз. Этот код проходит по столбцу B и для всех значений больше нуля копирует данные из соседнего столбца на "Лист2" в столбец С.

а второе - крайне рекомендую на будущее, прежде чем использовать какой-бы не было код, хотя бы оценить, что он может делать - иначе можно получить весьма забавные (и не очень) сюрпризы... Из кода VBA лёгко не только очистить все открытые книги и сохранить их, но и удалить файлики на диске и даже скачать и выполнить код из интернета...
Так что тщательнее надо, тщательнее... ;-)))

aar и The okk

Поставьте, хоть в виртуалку, офис 97 и сами сравните хелп - хотя бы по таким фичам как "см. также" и примеры кода.

Его теперь просто по объему раза в три меньше (антифлейм: линейкой не мерял). Причем отнюдь не за счет "воды" - в этом можно убедиться, опять-таки ознакомившись со старым хелпом.

LevT
Ну, а можно этот старый хэлп от 97-го офиса отдельно выложить? Просто нет дистрибутива.

vzbzdnov
Моментально отрабатывается (Excel 2003 SP2, ноутбук с Athlon 1.6 ГГц, 512 Мб).

Это снова я с вопросом о том, как определить нажатую кнопку на листе Excel.
Решение найдено. Помог Димитр с форума РЕЛИБа. Если кому интересно, публикую.

Код: ' Вариант-1.
' С использованием OLE-объекта "CommandButton".
' -----------------------------------------------------
' Class Modules
' Class1

' (Declatations)
Option Explicit
Public WithEvents myCmdButton As MSForms.CommandButton
Dim i As Long

' Click
Private Sub myCmdButton_Click()
' здесь любой код, использующий свойства "myCmdButton"
' например
MsgBox myCmdButton.Caption
        Range("anyName1").Value = myCmdButton.Index
        Range("anyName2").Value = myCmdButton.Name
        Range("anyName3").Value = myCmdButton.Top
End Sub

' -----------------------------------------------------
' Modules
' Module1

' (Declatations)
Option Explicit
Public arrCmdBut() As New Class1
Dim objCmdBut As OLEObject

' AddMassiv
Sub AddMassiv()
Dim i As Long
    i = 1
    For Each objCmdBut In Sheets(1).OLEObjects
        If TypeName(objCmdBut.Object) = "CommandButton" Then
            ReDim Preserve arrCmdBut(1 To i)
            Set arrCmdBut(i).myCmdButton = objCmdBut.Object
            i = i + 1
        End If
    Next
End Sub
' -----------------------------------------------------

' Microsoft Excel Objects
' Лист1

' Activate
Private Sub Worksheet_Activate()
    AddMassiv
End Sub

' ЭтаКнига
' Open
Private Sub Workbook_Open()
AddMassiv
End Sub
' ----------------------------------------------------

' Вариант-2.
' С использованием объекта "Button" (Toolbars "Forms").
' Просто назначить всем кнопкам макрос "arrButtonID".
' -----------------------------------------------------
' Modules
' Module1

Option Explicit
Sub arrButtonID()
Dim strTemp As String
strTemp = CStr(Application.Caller)
Range("anyName1").Value = strTemp
Range("anyName2").Value = Mid(strTemp, InStr(strTemp, " ") + 1)
End Sub

Добрый вечер, подскажите пожалуйста как решить такую вот задачу

Составить событийную процедуру, которая при изменении значения количества товара в клетке (Кол-во), и если в клетке слева цена товара (Цена) задана, вычисляет стоимость (Стоимость) и записывает ее в клетку справа.
Использовать процедуру:
Private Sub Worksheet_Change(ByVal Target As Range)
Товар выбирается с помощью валидирования, которое уже задано.
Для нахождения цены использовать функции поиска и данные на листе 2, при этом если товар в клетке не задан, то и клетка с ценой остается пустой.
Имена диапазонам на листе 2 заданы.

Ооочень жду от вас помощи....

aar

Дык у меня его тоже под рукой нет - одни ностальгические воспоминания... когда приходится лезть в хелп нынешний.
ну и потом без интеграции какой смысл?

Troitsky
aar
Да знаю, что в 2003 всё пучком! А вы в 2007 попробуйте!!!

olinka1986
А решение из шапки темы не подходит?

Цитата:

# Конкретные вопросы:
Форма-заставка
Как запустить макрос при изменении положения курсора или значения ячейки
# Пример 1
# Пример 2
# Пример 3 (проверка области)
# Пример 4
# Пример 5

Я пыталась...и примеры брать... никак...
)) спасибо..буду ещё пытаться..у меня помимо этого очень много остальных заданий...с этим не могу никак до конца справится...

# ??? Очень мучает вопрос - где хранятся описания пользовательских функций и их аргументов?
Где их прописывать, чтобы они были видны привыборе функции и её заполнении

Цитата:

А почему просто не поставить в последнюю ячейку формулу суммы? Или так: Данные - Итоги...

Если я поставлю в последнюю ячейку формулу суммы, то при последующем обновлении если придёт таблица с бОльшим числом строк, эта формула просто сотрётся, либо в ней будет указан диапазон строки предыдущей таблицы (той, которая пришла месяц назад). Данные-Итоги тоже не то, что нужно...

Подскажите, пожалуйста, есть ли в Excel VBA конструкции наподобие хэшей в Perl, то есть чтобы доступ к значению осуществлялся по ключу.

---

jONES1979
Спасибо.

aar
не знаю, как в "перле", а в VBA доступен объект "Scripting.Dictionary" ...
вроде бы тоже работает по принципу "ключ-значение" ... см google

Добрый день!
Помогите плз найти причину ошибки 91 (Object variable or With block variable not set ).
Причем если убираю вызовы (их 2) другого макроса (Application.Run "'Оплата безналом2003.xls'!NewZaivkaVuvod"), то ошибки нет. По отдельности макросы работают.

Код
Sub VuvodZaivki1()
'excecute the first find
Dim c As Range
Dim curZaivka(30) As Long
Dim iZaivka As Integer
Dim firstAddress As String, lastaddress As String

iZaivka = 0
Worksheets("Заявки").Activate
Range("A1").Activate
'поиск 1
Set c = ActiveSheet.Cells.Find(What:="@", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not c Is Nothing Then
'1
firstAddress = c.Address
'2
lastaddress = c.Address
'3
curZaivka(iZaivka) = Worksheets("Заявки").Range("A" & c.Row)
MsgBox (curZaivka(iZaivka))
'4
iZaivka = iZaivka + 1
Range("C" & c.Row).Activate
'5 reserved
Worksheets("Вывод").Range("A1").Formula = "=Заявки!A" & c.Row
'6 reserved
Application.Run "'Оплата безналом2003.xls'!NewZaivkaVuvod"
'следующий поиск
Do While c.Address <> firstAddress & iZaivka <> 1
' Range("C" & c.Row).Activate
Set c = ActiveSheet.Cells.Find(What:="@", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
'2
??? lastaddress = c.Address ///ВОТ ТУТ ДАЕТ ОШИБКУ
If c.Address = firstAddress Then
Exit Do
firstAddress = ""
lastaddress = ""
iZaivka = 0
End If
'3
curZaivka(iZaivka) = Worksheets("Заявки").Range("A" & c.Row)
MsgBox (curZaivka(iZaivka))
'4
iZaivka = iZaivka + 1
'5 reserved
Worksheets("Вывод").Range("A1").Formula = "=Заявки!A" & c.Row
'6 reserved
'Application.Run "'Оплата безналом2003.xls'!NewZaivkaVuvod"
'следующие поиски продолжение
Range("C" & c.Row).Activate
Loop
Else
firstAddress = ""
lastaddress = ""
iZaivka = 0
MsgBox ("Не найдено")
End If
Set c = Nothing
End Sub

olinka1986
Цитата:

Составить событийную процедуру, которая при изменении значения количества товара в клетке (Кол-во), и если в клетке слева цена товара (Цена) задана, вычисляет стоимость (Стоимость) и записывает ее в клетку справа.

так что у Вас конкрентно не работает?
Киньте пример вашей таблицы (особенно лист 2 - с ценами) - посмотрим, что можно сделать!

kansky

Цитата:

Set c = ActiveSheet.Cells.Find(What:="@", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
'2
??? lastaddress = c.Address ///ВОТ ТУТ ДАЕТ ОШИБКУ

Меня терзают смутные сомненья. Уж не Nothing ли у тебя с после такого Set. Посмотри, что делает NewZaivkaVuvod - возможно, там Activesheet меняется.

Добавлено:
vasilyevd
Это аттрибуты. Не знаю, где они в VBE настраиваются, не нашел. Но пока знаю только один способ - экспортируешь модуль в файл bas, открываешь в текстовом редакторе, правишь и импортируешь обратно.
Например, описание функции будет:

Код: Attribute очистка.VB_Description = "Эта функция ничего не делает"

Цитата:

Меня терзают смутные сомненья. Уж не Nothing ли у тебя с после такого Set.

Если убрать вызовы макроса, то все работает и следует ,мое мнение, что не Nothing. (Там рядом MsgBox для контроля стоит)

kansky
Я говорю про второй Set. Первый-то отрабатывает нормально, а вот второй, скорее всего нет. То бишь @ он не находит.

tec4
Вот такой макрос повесь на кнопку (кнопку ты сам на лист поставь ):

Код: Sub itog()
Cells(Rows.Count, 1).End(xlUp).Offset(1) = _
WorksheetFunction.Sum(Columns(1))
End Sub

Цитата:

kansky
Я говорю про второй Set. Первый-то отрабатывает нормально, а вот второй, скорее всего нет. То бишь @ он не находит.

Я понял что про втроq, но на всякий случай проверил, убрал вызов макроса, в результате - макрос нашел все @ на листе. Те есть второй SET работает. Но пока нет вызова макроса.
Может ли Application.Run "'Оплата безналом2003.xls'!NewZaivkaVuvod" как то влиять на определение C?
Код обоих Set с одинаков по-моему.

kansky

Цитата:

Сорри, а можно немного подробнее объяснить

Насколько подробнее и что объяснить?


Цитата:

Кое что нашел про это вроде бы

Это я читал .

Добавлено:
olinka1986

Цитата:

Составить событийную процедуру, которая при изменении значения количества товара в клетке (Кол-во), и если в клетке слева цена товара (Цена) задана, вычисляет стоимость (Стоимость) и записывает ее в клетку справа.

Может, с помощью формулы?:
A B C

Цитата:

Меня терзают смутные сомненья. Уж не Nothing ли у тебя с после такого Set. Посмотри, что делает NewZaivkaVuvod - возможно, там Activesheet меняется.

The okk

Вот это было верно!!! )
Добавил перед Set
Worksheets("Заявки").Activate
все ок теперь

Спасибо за помощь огромное!

kansky

Цитата:

Спасибо за помощь огромное!

Рад был помочь.

Только лучше бы не "перед Set", а прямо в Set:

Код: Set c = Worksheets("Заявка").Find...

Не могу понять... В модуле вот такой код:

Код:
Type Node
Level As Integer
Criterion As Variant
End Type

Sub test()
Set TaxNodes = CreateObject("Scripting.Dictionary")

Dim N1 As Node
Dim C As Variant

N1.Level = 1
C(1) = "a"
C(2) = "b"
C(3) = "c"
N1.Criterion = C

TaxNodes.Add "777", N1
End Sub

aar

Цитата:

Что надо-то?

Например, класс Node с свойствами Level и Criterion

спасибо за помощь

The okk
Эх... спасибо Уже на перле написал.