» Excel VBA (часть 2)

Подскажите, что делать?
Создаю модуль класса. В нем допустим определяю одну публичную переменную.
Каким образом создавать новый объект на основе этого класса и ссылаться на него из другой книги (не из той, в которой находится модуль класса).

kronic

Цитата:

как можно из переменой содержащей разные симолы в том числе и управляющие оставить только : "+-0123456789."

Например, так:

Код: Sub Repl()

Dim i As Integer, MyString As String, NewString As String
MyString = "1q2w3e4r5t6y-u6+ " 'Пусть это наша переменная
For i = 1 To Len(MyString)
Select Case Mid(MyString, i, 1)
Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, "-", "+", "."
NewString = NewString & Mid(MyString, i, 1)
End Select
Next
MsgBox NewString 'Это требуемое значение

End Sub

SAS888
Огромное Спасибо.

Только одна проблема мне переменная NewString нужна с типом single, а не String.

Вопрос:
В макросе есть UserForm с CheckBoxами и TextBoxами. Как Сделать чтобы изменения внесенные в CheckBoxы и TextBoxы сохранялись. Например, я запусепю макрос со значением TextBoxа = "Эгегей". Что нужно сделать, чтобы при запуске следующий раз, TextBox был уже с превидущим значением "Эгегей"

Выпадающий список с данными из файла надстройки
Есть известное решение "Выпадающий список с данными из другого файла"

Когда то у меня получилось сделать следующий вариант:
Создал файл надстройку в которой есть перечисление доступных имен.
Надстройка загружается при старте Excel.

В необходимых пользовательских файл список допустимых значений вытаскивал из файл надстройки, точно работало, но теперь не могу вспомнить как это повторить.

Может быть кто то подскажет?

kronic

Цитата:

мне переменная NewString нужна с типом single, а не String.

Можно. Но тогда будут некоторые ограничения. Т.е. если символы "+" или "-" встретятся в середине строки, то преобразовать в тип Single невозможно. Вот вариант:

Код: Sub Repl()

Dim i As Integer, MyString As String, NewString As String, MyVal As Single
MyString = "-1q2w3e4r5t6yu6" 'Пусть это наша переменная
For i = 1 To Len(MyString)
Select Case Mid(MyString, i, 1)
Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, "-", "+", "."
NewString = NewString & Mid(MyString, i, 1)
End Select
Next

On Error Resume Next
MyVal = CSng(NewString)
If Err = 0 Then MsgBox MyVal Else MsgBox "Преобразование невозможно!"
On Error GoTo 0

End Sub

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

Спс за ответ... А то сижу тут и ломаю голову, как сохранить на форме значения с прошлого использования. А этого нельзя сделать (на листах лень хранить)...

SAS888
Разобрался добавил еще:
[more]
Sub Repl()

Dim i As Integer, MyString As String, NewString As String, MyVal As Single
MyString = "-1q2w3e4r5t6yu6" 'Пусть это наша переменная
For i = 1 To Len(MyString)
Select Case Mid(MyString, i, 1)
Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, "-", "+", "."
NewString = NewString & Mid(MyString, i, 1)
End Select
Next

On Error Resume Next
Myval = Val(NewString)
MyVal = CSng(NewString)
If Err = 0 Then MsgBox MyVal Else MsgBox "Преобразование невозможно!"
On Error GoTo 0

End Sub
[/more]

Цитата:

Выпадающий список с данными из файла надстройки

Решил все сам.
Сделал файл надстройки, внем именованные списки с допустими значениями (для проверки). Поместил файл надстройки в папку автозапуска.

Теперь могу использовать в разных файлах один список для проверок НЕ ОТКРЫВАЯ файл с списком проверки (реально файл надстройки грузится, но при этом не светится как открытый файл, и главное что можно использовать без указания полного пути к контрольному файлу).
Вот пример формулы
=ДВССЫЛ("'[list_names.xla]names1'!_L_CategoryList")

=ДВССЫЛ("'[list_names.xla]names1'!_L_ClassList")

привет
мне нужно в excel или как form сделать 2 и более combobox связаных между собой
т.е. если в первом вывераеться item Россия, то во втором поевляеться Москва, Питер, Ростов, Владик, если в первом Франция то во втором Париж, Морсель и Ница
как это сделать?

TURNSKIN85
Посмотрите пример в Файле.

как сделать что бы это работало

Цитата:

Dim i as intenger
For i=100 to 1
label & i.caption =10
next

ВОПРОС

Можно ли заставить Excel общаться с другими компьютерами?

Расшаривать папки нельзя, а вот если VBA будет использовать открытый порт и обмениваться данными с другим компом, на котором запущено необходимое приложение то можно.

CEMEH
Теоретически, Excel можно заставить делать всё, что под силу WinAPI.

kronic

Цитата:

как сделать что бы это работало

Ну, во-первых, зачем цикл организовывать "сзаду наперед"? Если уж так хочется, то задавая цикл, нужно добавить Step -1.
А чтобы то, что Вы хотите, работало - нужно так:

Код: Dim i As intenger
For i = 1 To 100
Me.Controls("Label" & i).Caption = 10
Next

помогите накорябать простенький макрос, чтоб разом поделить на 1000 все значения в выделенном диапазоне..
пробовал такую конструкцию Selection.Cells.Value =Selection.Cells.Value / 1000 но выдаёт ошибку

crotoff


Код:
Sub Example()
A = Selection.Cells
For i = 1 To UBound(A, 1)
For j = 1 To UBound(A, 2)
A(i, j) = A(i, j) / 1000
Next j
Next i
Selection.Cells = A
Erase A
End Sub

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

ecolesnicov
что-то не получается, выдаёт ошибку "Method 'Cells' of object 'Range" failed
там скорее всего тип массива А определяется как Range. Но тогда границы надо задавать через Selection.Rows.Count и Selection.Columns.Count? А как же тогда его заполнить значениями?

А как сделать такой макрос?
Если A2>1 то к B2 добавляем A2-1, а дальше цикл на 100 строк
Например, A2=3 B2=товар. В B2 должно получиться товар2

Цитата:

А как сделать такой макрос?

if range("A1")>1 then ' Если A2>1 то...
range("B2")=range("A1")-1 ' ...к B2 добавляем A2-1
end if
' дальше цикл на 100 строк
for x=1 to 100
' тут тело цикла
next x


Цитата:

Например, A2=3 B2=товар. В B2 должно получиться товар2

А вот это я не понял. С работы только пришел, голова не варит.
Если в цикле надо перебирать строки то, например, выражение
range("A" & X)=123
вставленное в тело цикла, запишет в 100 строк столбца А значение 123

CEMEH, В А ничего записывать не надо там =СЧЁТЕСЛИ($B:$B;B2), т.е считаются повторы из столбца B, вот эти повторы мне и надо переименовать.
А B
3 товар
3 товар
3 товар
а после запуска макроса должно стать
А B
1 товар2
1 товар1
1 товар
Я не знаю, может можно это сделать по какому-нибудь другому алгоритму. Дано: столбец, в котором некоторые значения повторяются. Повторы нужно сделать уникальными значениями.
range("B2")=range("A1")-1 ' ...к B2 добавляем A2-1 - нужно, чтобы значение в B2 не заменялось, а к нему дописывалась цифра.

Цитата:

В А ничего записывать не надо там

я привел пример цикла

А стандартние "удалить дубликаты" не подойдет?

и может все-таки так?:
А B
1 товар3
1 товар2
1 товар1

тогда два вложенных цикла
первый считает строки, а второй от 1 до значения в столбце А
Внутри цикла код, который будет писать (на другом листе) необходимые значения.

Опиши подробнее свою задачку, файлик, если что, выложи.
Судя по всему некая часть работы уже выполнена?

crotoff

Цитата:

что-то не получается, выдаёт ошибку

Во-первых, в предложенный код необходимо вставить ряд проверок.
1. Если выделена одна ячейка (нет массива)
2. Арифметическое действие проводить только если элемент массива есть число.
Например, так:

Код: Dim i As Long, j As Long, a
a = Selection
If Not IsEmpty(a) Then
For i = 1 To UBound(a, 1)
For j = 1 To UBound(a, 2)
If IsNumeric(a(i, j)) Then a(i, j) = a(i, j) / 1000
Next
Next
Selection = a
End If

CEMEH, тут пример. Есть 2 прайса: старый и новый (2 листа). Нужно их сравнить. То, что совпадает выделяется зеленым, то чего нет в другом прайсе - красным, если изменилась только цена - желтым. НО ВПР находит только первое совпадение и останавливается, т.е несколько одинаковых наименований невозможно отловить (в реале это ноутбуки и у них действительно идентичные наименования, отличаются только ценой).

Цитата:

и может все-таки так?:
А B
1 товар3
1 товар2
1 товар1

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

SAS888
извиняюсь, у меня ёксель просто Portable, в этом всё и дело было. Самый первый вариант тоже работает, проверил под Open Office 3 (тоже Portable кстати).
Большое спасибо!

Цитата:

в реале это ноутбуки и у них действительно идентичные наименования, отличаются только ценой

Вот уж анекдот ))
Не в тему, но как продаются такие ноуты? Увидел покупец на витрине дорогой - купил дорогой. Увидел дешевый - купил дешевый.

Есть таблица из двух столбцов. Прайс. Имя и значение (цена). Сомневаюсь, что по такому прайсу, где три одинаковые колбасы можно сделать внятный анализ. В конечном итоге будет путанница.
Я с трудом представляю как будет работать программа. Можно сравнить за одно изменение цены. А потом?
допустим колбаса по 100 стала по 200 а колбаса по 300 стала по 150. Та, которая по 200 после обеда стала по 210, а половина из остатков по 300 стала по 400. Хотя на складе это одна и таже колбаса, просто лежит в разных углах.
Обязательно нужно либо к названию прикручивать ID либо дополнительный столбец.
программе надо как-то знать, что ноуты в левом углу склада пойдут по 500, а в правом по 700. то есть НоутЛев=500, НоутПрав=700. Достаточно на файл взглянуть и возникнут два вопроса А куда делась еще одна колбаса и по какой она цене?

В качестве предложения могу порекомендовать использовать прайс на одном листе. Каждый последующий столбец - новый прайс. В этом случае всю динамику можно проследить и необходимое цветом выделить.

SAS888
SAS888

вроде получилось, но перед первым значением появляется ";", это можно исправить? Спасибо, что откликнулись.


Цитата:

Sub Main()

Dim i As Long, k As String
k = "образованием земельного участка путем объединения земельных участков с кадастровыми номерами "
With Sheets("Заказчик")
For i = 9 To .Cells(Rows.Count, "I").End(xlUp).Row
If .Cells(i, "I") <> "" Then k = k & " ; " & .Cells(i, "I")
Next
End With
Sheets("Титульный").[A10] = k

End Sub

Цитата:

Вот уж анекдот ))
Не в тему, но как продаются такие ноуты? Увидел покупец на витрине дорогой - купил дорогой. Увидел дешевый - купил дешевый.

Согласен, но это не от меня зависит, они от продавцов такие приходят. Единого образца нет, у кого-то есть дополнительные столбцы с характеристиками, у кого-то все в одной ячейке.Все что мне надо, это к одинаковым названиям добавить 1,2,3 и т.д. Колбаса1, Колбаса2, Колбаса3, с ценой буду разбираться вручную.

Цитата:

Все что мне надо, это к одинаковым названиям добавить 1,2,3 и т.д

Организовываем цикл от первой до последней занятой ячейки.
Используя =СЧЁТЕСЛИ проверяем на одинаковые названия
если названий больше 1 то
задаем цикл от 1 до количества названий (если использовать ИНДЕКС(ПОИСКПОЗ() либо от 1 до конца, если не использовать ИНДЕКС(ПОИСКПОЗ()
в цикле НАЗВАНИЕ = НАЗВАНИЕ & переменная цикла
вот и все

' в столбце А 100 наименований
' к одинаковым будет добавлен порядковый номер
For X=1 to 100 '
A=Range("A" & X)
B=Application.WorksheetFunction.CountIf(Range("A:A"), A)
If B>1 then
For Y=1 to 100
IF Range("A" & Y)=A Then Z=Z+1 : Range("A" & Y)=Range("A" & Y) & Z
Next Y
Z=0
End if
Next X