Ru-Board.club
← Вернуться в раздел «Прикладное программирование»

» Excel VBA (часть 3)

Автор: aidomars
Дата сообщения: 22.02.2012 20:15
kser
Я бы сделал массивами. Узнаем сколько уникальных городов. Присваиваем данные. Вставляем массив на лист.
Автор: psiho
Дата сообщения: 22.02.2012 20:46
kser, алгоритм работы макроса должен быть таким:
1.макрос составляет список регионов по значениям столбца № 2
2. Для каждого имени рагиона проверятеся наличие в книге листа с таким же названием.
3.Если листа нет, то создается новый, туда в первую строку копируется шапка таблицы данных
4. Для каждого региона фильтруются данные и эти данные копируются на соответствующий лист в конец.
5.Затем происходит отсылка данных.
Единственное, на Вашей совести, внести данные электронных адресов отсылки данных.
А лучше, в этой же книге создать лист с названиями регионов и их элекронными адресами для упрощения проверки.
Автор: phoneadmin
Дата сообщения: 23.02.2012 13:04
IT-народ.
Как решить след задачу на VBA под эксель.
Имеются диапазон номеров:
4951234567-4951234582
как на выходе получить след, результат:
наиболее короткий префикс-маску, который однозначно покрывает часть номеров диапазона
в данном примере результата равен:
4951234567
4951234568
4951234569
495123457
4951234581
4951234582

Автор: AndVGri
Дата сообщения: 24.02.2012 06:48
phoneadmin

Цитата:
покрывает часть номеров диапазона

Каков критерий этой маски?

Цитата:
Имеются диапазон номеров

Где имеются?

Цитата:
в данном примере результата равен

Вроде же разговор про маску - тогда что это - маски?
Автор: djcrocodile
Дата сообщения: 24.02.2012 10:15
Очень нужна помощь: можно ли средствами excel сделать следующее (желательно с инструкциями, так как я в екселе чайник):

есть 3 колонки с данными:

надо провернуть такую махинацию: посмотреть что в A1 найти это значение в B (предположим это окажется B32), прочитать что в C32 и вписать в D1 то что находится в C32

потом также: посмотреть что в A2. найти это в B (например окажется в B875), прочитать C875 и вписать значение в D2


всего в столбике A около 3000 строк, надо пройтись по ним всем и составить столбик D, B и C потом удаляться и остануться только A и D



p.s. excel 2010 - если дадите пример по другой версии, установлю и ее )




Добавлено:
Поковырялся в справке, вроде нашел как формулой сделать:

=ВПР($A1;B1:C3376;2;ЛОЖЬ)

Тоесть я ищу значение указанное в A1 в таблице от B1 до C3376 и выписываю результат из с точным соответствием (двойку методом тыка подобрал)

Вроде работает

Автор: aidomars
Дата сообщения: 24.02.2012 12:06
djcrocodile, это для Excel FAQ вопрос
=ВПР(A1;B:C;2;0)
Автор: kser
Дата сообщения: 24.02.2012 12:18
psiho aidomars Спасибо за помощь, но выяснил что там значительно больше условий выбора из базы, и в связи с этим мне понадобится некоторое время чтоб осмыслить всю полноту выборок из базы.

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

Отпишусь в течении 2-3 дней.
Автор: phoneadmin
Дата сообщения: 24.02.2012 15:55


Цитата:
Каков критерий этой маски?

маска должна покрывать все номера выделенного диапазона, при этом не должна залезать в другой диапазон.
Т.е по сути это более короткий префикс серии номеров.
Например диапазон 201000-201999 имеет 1000 номеров. Все номера в данном диапазоне накрываются маской префиксом 201. Сложнее когда номера в диапазоне отдают не с 0 номера а ещё с какого либо. В таком случае одной маской не закроешь.
Например 211005-211099, получается след.префиксы:
211005,211006,211007,211008,211009,21109

Цитата:
Где имеются?

в стлбце Excel

Цитата:
Вроде же разговор про маску - тогда что это - маски?

Совершенно верно, это все маски данного диапазона.
Автор: kser
Дата сообщения: 25.02.2012 20:15
psiho
День добрый!

Вот выпилил кое что, при условии , что мои познания в программировании равны нулю.
На самом деле записывал куски макроса средствами excel, копировал в блокнот, кое что нашел в инете, а дальше просто собрал из кусков.
Вот результат: Ссылку из поста удалил, потому что отправил её вам в личку.

Если будет время, посмотрите плиз.
Автор: Kuz9
Дата сообщения: 26.02.2012 14:54
[more] Такая бЯда. Делал отчет, в котором есть объединенные ячейки, в которые выводится строчный текст. Как известно в экселе баг с авторасширение объединенных ячеек, я нашел макрос, которые считает высоту, подредактировал его, но пока. Остался один штрих, нужно в цикле нужно задать условие, которое будет проверять объединены ли мои ячейки, если да то выставлять автовысоту, если нет то след ячейка. Те ячейка "F15:I15", "F16:I16" могут быть объединены, а след ячейки "F17:I17" не объединены, 18 объединена.


Sub RowHeightFiting3()
' ???????????? ?????? ?????? ???? ????????!!!
' ???? ????????? ????????? ?????? ??? ?????????? ??????, ?? ????? ?????????? MyRanAdr ????????? ?????? ????? ??????? ???????????? ?????? '(????, MyRanAdr = "D4:G7" ?????? ?????? MyRanAdr = ActiveCell.MergeArea.Address)
Application.ScreenUpdating = False

Dim MyNormalMiddleWidth, MyNormalEdgeWidth
Dim c1, c2, w1, w2 '????????? ?????????? ????? ???????? ? ???? ? ??
Dim MyTempCell As Range
Dim OldColWidth
Set MyTempCell = Cells(65536, 256)
OldColWidth = MyTempCell.ColumnWidth
c1 = 10 ' ?????? ? ???? ????? ?????????? ?????, ?? ????? ?? ????? 1 (??? ?????? ??????? ?????????? ?????? ??? ??????),
c2 = 15 ' ? ????? ????? 3 ? ????????????? (??? ?????????? ??????? ?????? ??????????..... ???????, ? ???? ??? ????????? ?????? ???????????)
MyTempCell.ColumnWidth = c1
c1 = MyTempCell.ColumnWidth
w1 = MyTempCell.Width
MyTempCell.ColumnWidth = c2
c2 = MyTempCell.ColumnWidth
w2 = MyTempCell.Width
MyNormalMiddleWidth = Format((w2 - w1) / (c2 - c1), "#0.00")
MyNormalEdgeWidth = Format((c2 * w1 - c1 * w2) / (c2 - c1), "#0.00")
MyTempCell.ColumnWidth = OldColWidth
Dim MyRanAdr(50) As String

MyRanAdr(0) = "F15:I15"
MyRanAdr(1) = "F16:I16"
MyRanAdr(2) = "F17:I17"
MyRanAdr(3) = "F18:I18"
MyRanAdr(4) = "F19:I19"
MyRanAdr(5) = "F20:I20"
MyRanAdr(6) = "F21:I21"
MyRanAdr(7) = "F22:I22"
MyRanAdr(8) = "F23:I23"
MyRanAdr(9) = "F24:I24"
MyRanAdr(10) = "F25:I25"
MyRanAdr(11) = "F26:I26"
MyRanAdr(12) = "F27:I27"

For b = 0 To 12
'здесь шлепнуть наш If проверяющий объединенная ли ячейка или нет
Dim MergeAreaTotalHeight(50), NewRH(50) As Long
Dim MergeAreaFirstCellColWidth(50), MergeAreaFirstCellColHeight(50) As Long
MergeAreaTotalHeight(b) = Range(MyRanAdr(b)).Height ' ?????? ???? ???????????? ?????? ? ??. ??
MergeAreaFirstCellColWidth(b) = Range(MyRanAdr(b)).Cells(1, 1).EntireColumn.ColumnWidth ' ?????? ??????? ??????? ? ???????????? ??????
MergeAreaFirstCellColHeight(b) = Range(MyRanAdr(b)).Cells(1, 1).EntireRow.RowHeight ' ?????? ?????? ?????? ? ???????????? ??????
Range(MyRanAdr(b)).Cells(1, 1).ColumnWidth = (Range(MyRanAdr(b)).Width - MyNormalEdgeWidth) / MyNormalMiddleWidth '????????? ?????? ??????? ??????? ?????. ?????? ?????? ????? ?????? ?????. ?????? '''??? ????????!!!
Range(MyRanAdr(b)).WrapText = True
Range(MyRanAdr(b)).MergeCells = False
Range(MyRanAdr(b)).Cells(1, 1).EntireRow.AutoFit
NewRH(b) = Range(MyRanAdr(b)).Cells(1, 1).EntireRow.RowHeight
Range(MyRanAdr(b)).MergeCells = True
Range(MyRanAdr(b)).Cells(1, 1).EntireColumn.ColumnWidth = MergeAreaFirstCellColWidth(b)
If NewRH(b) < MergeAreaTotalHeight(b) Then '???? ????? ?????? ?????? ???????????, ?? ????????? ??????????? ??????!
Range(MyRanAdr(b)).Cells(1, 1).EntireRow.RowHeight = MergeAreaFirstCellColHeight(b)

Else
Range(MyRanAdr(b)).Cells(1, 1).EntireRow.RowHeight = NewRH(b) - (MergeAreaTotalHeight(b) - MergeAreaFirstCellColHeight(b)) ' ??? 1st ?????? ? ?????.??????
End If
'Range(MyRanAdr).EntireRow.RowHeight = NewRH / Range(MyRanAdr).Rows.Count '??? ?????? ?????? ???? ????? ? ?????.?????? (?????? ??????????? ????? If)
Application.ScreenUpdating = True
Next b
End Sub [/more]
Автор: JekG
Дата сообщения: 27.02.2012 01:05
Подскажите пожалуйста.
Есть юзерформа из двух текстбоксов в один из которых макросом вставляется рандомное (произвольное) цифровое значение, а во второй по нажатию на кнопку тем же макросом считается по формулам результат.
Проблема в том, что результат дается только для первого значения первого текстбокса. Дальше по нажатию на кнопку меняется значение первого текстбокса, но результат во втором не пересчитывается.
Как его "зациклить"?
Автор: AndVGri
Дата сообщения: 27.02.2012 01:34
phoneadmin
Поскольку все значения сведены в столбец и числовые (насколько я вас понял), то
1. считываем данные столбца

Код:
Dim vData As Variant
vData = Range(Cells(beginRow, ColID), Cells(endRow, ColID)).Value
Автор: panda3
Дата сообщения: 27.02.2012 10:06
Вот так вот примерно можно маски найти:

Код:
Sub Masks()
Dim nstart As Long, nend As Long, r As Range

nstart = 201000: nend = 201999
Set r = Cells(1, 1)

Do While nstart < nend
Do While (nstart Mod 10 <> 0) And (nstart < nend)
r.Value = nstart: Set r = r.Offset(1)
nstart = nstart + 1
Loop
Do While (nend Mod 10 <> 9) And (nend > nstart)
r.Value = nend: Set r = r.Offset(1)
nend = nend - 1
Loop
If nstart = nend Then Exit Do
nstart = nstart / 10
nend = (nend - 9) / 10
Loop
r.Value = nstart
End Sub
Автор: Kuz9
Дата сообщения: 27.02.2012 11:05
Здравствуйте! Подскажите пожалуйста кто знает, мне нужно условие которое будет проверять объединены ли ячейки.
У меня есть переменные
Dim MyRanAdr(50) As String

MyRanAdr(0) = "F15:I15"
MyRanAdr(1) = "F16:I16"
MyRanAdr(2) = "F17:I17"
MyRanAdr(3) = "F18:I18"
MyRanAdr(4) = "F19:I19"
....
For b = 0 To 12 ' цикл
If Worksheets.Range(MyRanAdr(b)).MergeArea.Address <> Worksheets.Range(MyRanAdr(b)).Address Then ' В нем условие, вот на него как раз и ругается компилятор....
Автор: SAS888
Дата сообщения: 28.02.2012 03:21
Kuz9
Свойство "MergeArea" - это свойство ячейки. А Вы применяете его для диапазона. Поэтому и ругается компилятор. Условие задать можно так:

Код: If Range(MyRanAdr(b)).Cells(1, 1).MergeArea.Address <> Range(MyRanAdr(b)).Address Then...
Автор: visual73
Дата сообщения: 28.02.2012 18:35
Помогите разобраться в проблеме.
Нужно вызвать определённый раздел файла помощь Help.chm.
Вставил как в примере Уокенбаха:
1. В модуль книги

Private Sub Workbook_Open()
Call SetOptions
End Sub

2. В обычный модуль

Sub SetOptions()
Application.MacroOptions Macro:="МояФункция", _
Description:="МояФункция считает то что я хочу", _
Category:=14, _
HelpContextID:=1006, _
HelpFile:=ThisWorkbook.Path & "\Help.chm"
End Sub

Вызываю функцию, кликаю помощь.
C файлом помощи из примера всё великолепно работает.
С моим собственным Хэлп файлом не запускается совсем. Пробовал прицепить на кнопку, мой Хэлп запускается только если не указываешь номер ID раздела, но в этом случае помощь открывается на начало. А если ставишь ID раздела то вообще не запускается файл.
Помощь пробовал создавать и в Help&Manual 6 - там можно ID вручную задавать, в т.ч. и текстом, и в программе WinCHM Pro 4.27 - там ID выставляются автоматом цифры. Результат одинаковый - мой пример не работает. Может причина в том, что моя фамилия не Уокенбах? )
Автор: AndVGri
Дата сообщения: 29.02.2012 03:20
visual73

Цитата:
в Help&Manual 6 - там можно ID вручную задавать, в т.ч. и текстом

По справке Excel
Цитата:
HelpContextId Optional Variant. An integer that specifies the context ID for the Help topic assigned to the macro.

В Help&Manual это числовое значение вписывается в Help Context

Автор: visual73
Дата сообщения: 29.02.2012 04:33
AndVGri
Вау! Здорово! Я всё по интуиции делаю, с английским сложновато.
Супер! Всё получилось. Я чувствовал что нужно вводить числа, но не догадался что это Help Context.
Всё заработало. И кнопка и вызов в функции.
В последнем варианте была также ошибка:

Application.MacroOptions Macro:="МойФунк", _
Description:="Она считает", _
Category:=14, _
HelpContextID:=1000, _
HelpFile:=ThisWorkbook.Path & "\Help.chm"

Application.MacroOptions Macro:="МойФунк", _
Description:="Она считает", _
Category:=14, _
HelpFile:=ThisWorkbook.Path & "\Help.chm", _
HelpContextID:=1000

После перестановки мест последних двух строчек заработало! Вроде без разницы при поименном вызове? Ан нет.
AndVGri - Спасибо большое!!!
Автор: psiho
Дата сообщения: 01.03.2012 19:59

Цитата:
If Worksheets.Range(MyRanAdr(b)).MergeArea.Address <> Worksheets.Range(MyRanAdr(b)).Address Then ' В нем условие, вот на него как раз и ругается компилятор....

Kuz9, ругается, потому что после "Worksheets" нужно указать название или номер листа, в котором размещён диапазон, т.е. нужно писать "Worksheets(1)" или "Worksheets ("Данные")"
Автор: SAS888
Дата сообщения: 02.03.2012 02:00
psiho
Все верно. Но если ссылка на рабочий лист будет записана правильно, то данная конструкция все равно не будет работать по причине, о которой я говорил в своем предыдущем посте. В предлагаемом (работоспособном) примере я просто "выбросил" ссылку на лист, имея ввиду активный.
Автор: Petro
Дата сообщения: 02.03.2012 20:17
Люди добрые, помогите кто может, задача: объединить строки с одинаковыми значениями. Нашел на просторах такой макрос:

Sub Объединить()
'
Dim i&, n&, arr, rn&
n = Cells(Rows.Count, 1).End(xlUp).Row + 1
arr = Cells(1, 1).Resize(n)
rn = 1
For i = 2 To n
If arr(i, 1) <> arr(i - 1, 1) Then
With Range(Cells(rn, 1), Cells(i - 1, 1))
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
rn = i
End If
Next
End Sub

Надо его доделать:
1. Макрос объединяет строки в первом столбце, а как сделать чтобы во всех объединял или в выделенном?
2. И еще для полного счастья - когда он объединяет выскакивает окно что объединение приведет к потере всех данных в диапазоне как от него избавиться? Чтобы автоматом соглашался короче.
Автор: alin
Дата сообщения: 02.03.2012 20:43
Доброго времени суток!
Помогите, пожалуйста, модулем или макросом.
Имеется таблица, которая не имеет конкретных ограничений по высоте и ширине ячеек:

Нужно получить файлы с расширением *.txt имена которых, будут значения первого столбца:
7.txt, 2.txt, 3.txt, 46.txt и т.д .
В каждом файле должны прописаться в столбик значения строк.
Например в файле 7.txt в столбец будут значения :
Вася
14
Пионер

XXX

Заранее благодарен!
Автор: psiho
Дата сообщения: 05.03.2012 12:30

Цитата:
Помогите, пожалуйста, модулем или макросом.

alin,лови файл:
http://files.mail.ru/Q0YTR6
Автор: alin
Дата сообщения: 05.03.2012 21:48
psiho
Всё работает!!!
Огромное спасибо!
Автор: psiho
Дата сообщения: 06.03.2012 07:08

Цитата:
If arr(i, 1) <> arr(i - 1, 1) Then

Petro,во-первых,как раз объединяет ячейки, если они разные.
Во-вторых, чтобы не выводилось сообщение, нужно в начале кода ввести Application.DisplayAlerts=false , а в конце,наоборот, Application.DisplayAlerts=true


Добавлено:
Petro,смотри примерчик:
http://files.mail.ru/QNSU7C
Объединяет только соседние строки и по всем столбцам, количество столбцов должно быть одинаковым.
Автор: PetrK
Дата сообщения: 11.03.2012 11:17
Необходимо получить из таблицы, расположенной слева перечень, расположенный справа? Есть похожий макрос?

Автор: AndVGri
Дата сообщения: 12.03.2012 01:39
PetrK
Вы шапку читали?
Или с planetaexcel перепутали? Да и там, при таком обращении...
Автор: psiho
Дата сообщения: 12.03.2012 06:47

Цитата:
Есть похожий макрос?

PetrK, Держи:http://files.mail.ru/KNN1WH
Автор: PetrK
Дата сообщения: 12.03.2012 09:23
psiho
Спасибо вам большое.
Замечательно работает.
Автор: kser
Дата сообщения: 12.03.2012 18:12
Огромное человеческое спасибо psiho за неоценимую помощь в разработке и допиливании макроса рассылки уведомлений!!!

Страницы: 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127

Предыдущая тема: VS 2010


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.