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

» Excel VBA

Автор: CMD
Дата сообщения: 01.09.2006 11:33
как проверить есть ли в выделенной диаграмме дополнительная ось?
Автор: Yuk
Дата сообщения: 01.09.2006 14:27
namomelkorsp
В ReDim Preserve можно менять только последнюю размерность.
Есть ли возможность определить размерность заранее? Например, прочитать весь файл, определить размер и вернуться назад.
Другой вариант - сначала читать столбцы в строки, а потом транспонировать массив в новый массив (циклом).
Автор: namomelkorsp
Дата сообщения: 01.09.2006 14:33
Yuk
Да можно и так я над этим уже думал
Просто хотел найти более простой и экономичный способ
Автор: Yuk
Дата сообщения: 01.09.2006 14:48
CMD

Цитата:
как проверить есть ли в выделенной диаграмме дополнительная ось?


Код: Dim secondary As Boolean
For Each a In ActiveChart.Axes
If a.AxisGroup = xlSecondary Then
secondary = True
End If
Next
If secondary Then MsgBox "Chart contain secondary axes"
Автор: DONRU1
Дата сообщения: 01.09.2006 18:09
Yuk
Спасибо за подсказку, я пошел от обратного - ставлю сам разрывы страниц
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell

У меня возник более сложный вопрос:
Есть описание алгоритма расчета контрольного числа расходного расписания
Вроде все расписано, но никак не пойму как это применить

Контрольное число расходного расписания определяется по следующему алгоритму:
int CRCTAB_16[]={
0x0000, 0x1021, 0x2042, 0x3063, 0x4084, 0x50A5, 0x60C6, 0x70E7,
0x8108, 0x9129, 0xA14A, 0xB16B, 0xC18C, 0xD1AD, 0xE1CE, 0xF1EF,
0x1231, 0x0210, 0x3273, 0x2252, 0x52B5, 0x4294, 0x72F7, 0x62D6,
0x9339, 0x8318, 0xB37B, 0xA35A, 0xD3BD, 0xC39C, 0xF3FF, 0xE3DE,
0x2462, 0x3443, 0x0420, 0x1401, 0x64E6, 0x74C7, 0x44A4, 0x5485,
0xA56A, 0xB54B, 0x8528, 0x9509, 0xE5EE, 0xF5CF, 0xC5AC, 0xD58D,
0x3653, 0x2672, 0x1611, 0x0630, 0x76D7, 0x66F6, 0x5695, 0x46B4,
0xB75B, 0xA77A, 0x9719, 0x8738, 0xF7DF, 0xE7FE, 0xD79D, 0xC7BC,
0x48C4, 0x58E5, 0x6886, 0x78A7, 0x0840, 0x1861, 0x2802, 0x3823,
0xC9CC, 0xD9ED, 0xE98E, 0xF9AF, 0x8948, 0x9969, 0xA90A, 0xB92B,
0x5AF5, 0x4AD4, 0x7AB7, 0x6A96, 0x1A71, 0x0A50, 0x3A33, 0x2A12,
0xDBFD, 0xCBDC, 0xFBBF, 0xEB9E, 0x9B79, 0x8B58, 0xBB3B, 0xAB1A,
0x6CA6, 0x7C87, 0x4CE4, 0x5CC5, 0x2C22, 0x3C03, 0x0C60, 0x1C41,
0xEDAE, 0xFD8F, 0xCDEC, 0xDDCD, 0xAD2A, 0xBD0B, 0x8D68, 0x9D49,
0x7E97, 0x6EB6, 0x5ED5, 0x4EF4, 0x3E13, 0x2E32, 0x1E51, 0x0E70,
0xFF9F, 0xEFBE, 0xDFDD, 0xCFFC, 0xBF1B, 0xAF3A, 0x9F59, 0x8F78,
0x9188, 0x81A9, 0xB1CA, 0xA1EB, 0xD10C, 0xC12D, 0xF14E, 0xE16F,
0x1080, 0x00A1, 0x30C2, 0x20E3, 0x5004, 0x4025, 0x7046, 0x6067,
0x83B9, 0x9398, 0xA3FB, 0xB3DA, 0xC33D, 0xD31C, 0xE37F, 0xF35E,
0x02B1, 0x1290, 0x22F3, 0x32D2, 0x4235, 0x5214, 0x6277, 0x7256,
0xB5EA, 0xA5CB, 0x95A8, 0x8589, 0xF56E, 0xE54F, 0xD52C, 0xC50D,
0x34E2, 0x24C3, 0x14A0, 0x0481, 0x7466, 0x6447, 0x5424, 0x4405,
0xA7DB, 0xB7FA, 0x8799, 0x97B8, 0xE75F, 0xF77E, 0xC71D, 0xD73C,
0x26D3, 0x36F2, 0x0691, 0x16B0, 0x6657, 0x7676, 0x4615, 0x5634,
0xD94C, 0xC96D, 0xF90E, 0xE92F, 0x99C8, 0x89E9, 0xB98A, 0xA9AB,
0x5844, 0x4865, 0x7806, 0x6827, 0x18C0, 0x08E1, 0x3882, 0x28A3,
0xCB7D, 0xDB5C, 0xEB3F, 0xFB1E, 0x8BF9, 0x9BD8, 0xABBB, 0xBB9A,
0x4A75, 0x5A54, 0x6A37, 0x7A16, 0x0AF1, 0x1AD0, 0x2AB3, 0x3A92,
0xFD2E, 0xED0F, 0xDD6C, 0xCD4D, 0xBDAA, 0xAD8B, 0x9DE8, 0x8DC9,
0x7C26, 0x6C07, 0x5C64, 0x4C45, 0x3CA2, 0x2C83, 0x1CE0, 0x0CC1,
0xEF1F, 0xFF3E, 0xCF5D, 0xDF7C, 0xAF9B, 0xBFBA, 0x8FD9, 0x9FF8,
0x6E17, 0x7E36, 0x4E55, 0x5E74, 0x2E93, 0x3EB2, 0x0ED1, 0x1EF0
};


Пример текста программы расчета контрольного числа строки (на языке программи-рования – Visual Basic):

Предварительо необходимо произвести обработку массива CRCTAB_16 (!!!!)

For i = 0 To UBound(CRCTAB_16)
CRCTAB_16(i) = CRCTAB_16(i) And &HFFFF&
Next i

Private Function calcCRC16(ByVal iPrevSumm As Long, ByRef btArr() As Byte, ByVal iLen As Long) As Long
Dim i As Long

For i = 0 To iLen
iPrevSumm = CLng(CRCTAB_16((((iPrevSumm \ 256)) And &HFF)) Xor ((iPrevSumm And &HFF) * 256) Xor (btArr(i))) And &HFFFF
Next i
calcCRC16 = iPrevSumm
End Function

Параметры:
IprevSumm - предыдущая сумма. При начальном вызове должна быть равна 0.
btArr() – байтовый входной массив, контрольное число которого надо получить
iLen – длина вышеуказанного байтового массива.

Пример:
Уменя есть строка, полученная из текстового файла.
100/46823/0021004682324.03.200524.03.2005950004001Яковлева Е. П.Антонова О. В.10001151005000213310100001000000100011510000100001000010000100100310004061972622899000010000001001003289900001000028990000100002900000029000000

Каким образом получается контрольная сумма. 59977
Автор: Yuk
Дата сообщения: 01.09.2006 23:54
ZORRO2005

Цитата:
Есть 3 листа:
На первом листе есть список из артикулов:
A2,A3,B2,B3,C2,C3(это наименование артикулов)

На втором листе есть список из артикулов:
A1,A3,B1,B3,C1,C3

На третьем листе есть список из артикулов:
A1,A2,B1,B2,C1,C2


Есть итоговый лист где нужно получить список:
A1,A2,A3,B1,B2,B3,C1,C2,C3
то есть со всех листов нужно собрать все артикулы и оставить только
уникальные(все дубликаты и пустые удалить)

P.S.Артикулов около 400
Кол-во не постоянное
--------------------------------------
Делал так:
Скопировал списки друг под другом
а потом сделал сводную таблицу

ЕСТЬ ЛИ СПОСОБ ПРОЩЕ?


Код с парой функций [more=тут]
Код: Option Explicit
Option Base 1

Sub MergeArt()
Dim arr As Variant
Dim ws As Integer
Dim rcnt As Long
Dim alen As Long
Dim r As Long

'Some optimization
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

ReDim arr(1)
alen = 0
For ws = 1 To 3
rcnt = Sheets(ws).UsedRange.Rows.Count - 1
ReDim Preserve arr(rcnt + alen)
For r = 1 To rcnt
arr(r + alen) = Sheets(ws).Cells(r + 1, 1).Value
Next
alen = alen + rcnt
Next
SortArray arr
RemoveDuplicates arr
For r = 1 To UBound(arr)
Sheets(4).Cells(r + 1, 1).Value = arr(r)
Next
Sheets(4).Select

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Done"
End Sub

Private Sub SortArray(ByRef a As Variant)
Dim i As Long, j As Long
Dim t As Variant

'standard bubble sort loops
For i = LBound(a) To UBound(a) - 1
For j = i + 1 To UBound(a)
If a(i) > a(j) Then 'change to < for descending order
t = a(i)
a(i) = a(j)
a(j) = t
End If
Next j
Next i
End Sub

Private Sub RemoveDuplicates(ByRef a As Variant)
Dim i As Long, j As Long
j = 1
Dim t() As Variant
ReDim t(1)
t(1) = a(1)
For i = LBound(a) To UBound(a) - 1
If a(i) <> a(i + 1) Then
j = j + 1
ReDim Preserve t(j)
t(j) = a(i + 1)
End If
Next i
ReDim a(j)
a = t
End Sub
Автор: utmpatpc
Дата сообщения: 02.09.2006 12:54

Цитата:
Попробуй поизменять число здесь:
Цитата:Application.Wait Now + 0.00002 ' delay

Можно задать задержку явным образом (10 секунд):
Код:Application.Wait Now +TimeValue("0:00:10")

Yuk
Долго не писал, пытался поменять промежутки времени по твоему совету. Ничего не получается. Как валила куча данных от весов, так и продолжает валить. Где рыть ума не приложу, даже руки опускаются.
Help pls
Автор: namomelkorsp
Дата сообщения: 02.09.2006 17:55
как в vba удалить все картинки и элементы управления с листа
еще как на лист скопировать веб-страницу зная ее адресс (программно)
Автор: Yuk
Дата сообщения: 02.09.2006 20:28
utmpatpc
Пробовал ли еще раз связаться с производителем и задать ему мои вопросы?
Пробовал ли мой макрос, удаляюший лишние строки?

Цитата:
пытался поменять промежутки времени по твоему совету. Ничего не получается.

Попробуй в VBA редакторе поставить breakpoint на это строчку и посмотри, когда происходит к ней обращение. Перед каждым добавлением данных или нет?

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



Добавлено:
namomelkorsp

Цитата:
как в vba удалить все картинки и элементы управления с листа


Код: For Each i In ActiveSheet.Shapes
i.Delete
Next
Автор: utmpatpc
Дата сообщения: 04.09.2006 10:10
Yuk
Здравствуйте!

Цитата:
Пробовал ли еще раз связаться с производителем и задать ему мои вопросы?

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

Цитата:
Пробовал ли мой макрос, удаляюший лишние строки?

Макрос удаляющий строки вставил в ЛИСТ, ничего не происходит, наверно из-за того в каком виде представляется время (см. скриншоты)

Цитата:
Опиши как можно подробнее работу с этой программой

Запускаю экселевский шаблон, ввожу номер com-порта, к которому подключены весы, дальше запускается CPS Plus:
http://www.mytempdir.com/908222
Все, после этого идет ввод данных в Эксель.
http://www.mytempdir.com/908249
В CPS Plus удаляю первые 3 байта и последние 21, чтобы в Эксель вводился только вес.
Заметь в каком ввиде представляется время, выхожу из этого положения, созданием отдельного столбца, копирую туда время и меняю формат:
http://www.mytempdir.com/908282
В принципе все, код макроса я приводил выше, но вот выложил экселевкий шаблон на всякий случай:
http://www.mytempdir.com/908291

Мой номер ICQ 177830930
Заранее благодарен.
Автор: Yuk
Дата сообщения: 04.09.2006 21:47
Из Excel FAQ:
sizop:

Цитата:
У меня на отдельном листе составлен бланк паспорта. В разделе РЭС, из раскрывающегося списка выбирается РЭС. В разделе подстанции, также из раскрывающиегося списка, в котором имеются ТОЛЬКО те подстанции которые находятся в выбранном РЭСе, выбирается подстанция. Далее соответственно также выбирается КЛ, из списка тех КЛ, которые присутствуют на подстанции.


Цитата:
надо определить кабельную линию конкртного РЭСа, конкретной подстанции, взять по нему данные (полностью эта строка) и определить эти данные в паспорт на отдельном листе.


Цитата:
Здесь выложил файл размер 50 Кбайт чтобы на пальцах не объяснять.

Проблема зависимых выпадающих списков.
Поскольку бланка паспорта у меня нет, пришлось сделать самому.
Добавляешь новый лист, называешь Passport.
Начиная с A1, копируешь (включая пробелы):

Код: ЭС
Место установки
Диспетчерское наименование

Марка кабеля
Сечение кабеля
Длина кабеля, м
Год ввода
Срок эксплуатации
Тип муфты
наружной установки
внутренней установки
Длительно допустимая нагрузка, А
Зима
Лето
max нагрузка при аварийном режиме, А
Зима
Лето
Примечания
Автор: tarrac
Дата сообщения: 05.09.2006 00:04
А не подскажете как можно узнать номер последней заполненной ячейке в столбце не перебирая весь столбец он начала и до попадания орпеделенного кличества пустых строк подрят ?
Автор: Yuk
Дата сообщения: 05.09.2006 03:35
tarrac
Определить число используемых рядов:
nr = ActiveSheet.UsedRange.Rows.Count

Прыгаем вверх до последней заполненной ячейки:
lastrow = Cells(nr,col).End(xlUp).Row
где col - номер нужного столбца
Автор: sizop
Дата сообщения: 05.09.2006 05:15
Yuk
Ошибку выдает "Run-time error '9' Subscript out of range", после чего курсор выставляет на 11 строку.

Код: With Sheets("&#202;&#203;-10")
Автор: Yuk
Дата сообщения: 05.09.2006 05:30
sizop

Цитата:
Sheets("&#202;&#203;-10")

Там должно быть "КЛ-10". Видимо при переносе из экселя в браузер ошибочка вышла. Это должно быть в нескольких местах, я подправлю в посте.
Автор: sizop
Дата сообщения: 05.09.2006 05:35
Yuk
Сам подправил! Заработало. Буду пробовать разносить данные по нужным ячейкам. Огромное тебе спасибо! Ты внес неоценимый вклад, в становление энергосистемы России.
Автор: utmpatpc
Дата сообщения: 05.09.2006 09:21
Yuk
Спасибо!
Втавил код, он работает:
http://www.mytempdir.com/910331
Но есть проблемка, теперь удаляются строки с нулями, а мне нужна как раз обратная ситуация, когда строки с нулями остаются, а все остальное удаляется:
http://www.mytempdir.com/910329
Есть ли возможность переноса их на другой лист?

Цитата:
А почему нельзя отформатировать непосредственно столбец С? В коде выше это учитывается.

Можно, но только если остановить передачу данных, преобразовать в текст и потом изменить формат представления времени

Цитата:
Кстати, может тебе убрать строки, когда весы выдают 0?

Меня больше интересуют интервалы времени. Дело в том что по этим данным я буду строить кривые зависимости влажности от времени.
Влажность расчитываю по массе от весов, а вот по времени застрял, и ни туду и ни сюда
Автор: sizop
Дата сообщения: 05.09.2006 10:46
Yuk
Однако проблема с переносом в другие ячейки.
Вроде аккуратненько перенес, только вот первые два параметра выбираются нормально, а дисп. наименование (последний третий параметр) пустой список.
Да кстати, вопрос, а если строки будут добавляться, редактировать надо будет?
Автор: Anton T
Дата сообщения: 05.09.2006 12:55
Yuk
Почему после установки "надстройки" из файла "Книга1.xla", панель "Моя панель" уже установлен над панелом "Форматировине" и нажимал кнопку, например, "Добавить запись" или "Найти записи" выдает ошибку: Object variable or With block variable not set (Error 91)
Как исправить?

Побровал без надстройки, как обычный(Книга1.xls) запускал, работает без проблем.

Скачать сюда: _http://files.people.overclockers.ru/AntonT/_____1.xls и создай надстройки.
Автор: Lyubaha
Дата сообщения: 05.09.2006 13:30
Добрый день!
У меня вопрос.
Есть столбец с числами, нужно произвести суммирование этих чисел по порядку таким образом: нужно суммировать сначала элементы от первого до десятого и записывать результат... потом элементы от второго до двенадцатого... потом от третьего до тринадцатого... потом от четвертого до четырнадцатого... и т.д.
Напишите, пжста, пример функции или выражения для такого вычисления.
Заранее спасибо!
Автор: Yuk
Дата сообщения: 05.09.2006 14:42
sizop
Видимо где-то пропустил. Проверь блок Case "$B$2". (Обрати внимание, что в Case должны быть $$). Еще предполагается, что 3 ячейки с параметрами располагаются одна под другой (B1,B2,B3). Попробуй заменить Target.Offset(-1,0) на Range("B1").
В другом блоке Case "$B$3$" - Target.Offset(-2,0) на Range("B1") и Target.Offset(-1,0) на Range("B2").

Цитата:
а если строки будут добавляться, редактировать надо будет?
Нет. Заполнение списка ЭС идет каждый раз при активации листа Passport.
Кстати, тестируй, все ли данные присутствуют в выпадающих списках. Правильно ли заполняются ячейки.



Добавлено:
Anton T
Пока не смотрел.
Пришли, в какой конкретно строке вылетает.

Lyubaha
Можно и без VBA сделать, через дополнительный столбец и функцию СУММЕСЛИ. Подробности позже (если такой вариант устроит).
Автор: Troitsky
Дата сообщения: 05.09.2006 17:35
Lyubaha

Цитата:
нужно произвести суммирование этих чисел по порядку таким образом: нужно суммировать сначала элементы от первого до десятого и записывать результат... потом элементы от второго до двенадцатого... потом от третьего до тринадцатого... потом от четвертого до четырнадцатого... и т.д.

Вероятно, с первого по одиннадцатый, со второго по двеннадцатый.., группами по одиннадцать элементов?
Если так, тогда предположив, что элементы идут в столбце "А", в ячейке В11 можно записать формулу
Код: =СУММ(A1:A11)
Автор: sizop
Дата сообщения: 05.09.2006 18:14
Yuk
Вот все понятно, все работает, огромное, человеческое
Только вот объясни, нигде не могу найти, что за знак подчеркивания после Value?

Код: If .Cells(i, 2).Value = Range("I2").Value _
And .Cells(i, 3).Value = Range("I4").Value _
Автор: Yuk
Дата сообщения: 05.09.2006 18:18
utmpatpc
Блин, ошибся. В первой строчке должно быть

Код: If Second(CPS3$) Mod 10 = 0 Then
Автор: Troitsky
Дата сообщения: 05.09.2006 18:23
sizop

Цитата:
что за знак подчеркивания после Value?


Перенос строки, чтобы длинную строку разбить для наглядности на несколько коротких
Автор: Lyubaha
Дата сообщения: 06.09.2006 06:27

Цитата:
Troitsky
Вероятно, с первого по одиннадцатый, со второго по двеннадцатый.., группами по одиннадцать элементов?
Если так, тогда предположив, что элементы идут в столбце "А", в ячейке В11 можно записать формулу
Код:=СУММ(A1:A11)
и далее растянуть ее ниже по столбцу "В", тогда в ячейке В12 уже будет формула
Код:=СУММ(A2:A12)
и т.д.
Все это без VBA


Спасибо большое, я прекрасно понимаю, что можно и без VBA... Но суть проблемы в следующем: для ячеек
H104=КОРЕНЬ(ДИСП(F4:F104))
H105=КОРЕНЬ(ДИСП(F5:F105))
H106=КОРЕНЬ(ДИСП(F6:F106))
H107=КОРЕНЬ(ДИСП(F7:F107))
H108=КОРЕНЬ(ДИСП(F8:F108))
и т.д.

Нужно написать макрос, чтобы это все считалось автоматом. Потому что интервал дисперсии часто приходится менять. Т. е. он может быть равен 100, 250, 255...
И это не единственная задача для этого макроса...
Автор: utmpatpc
Дата сообщения: 06.09.2006 11:23
Yuk
УРА!!! Работает! Большое тебе человеческое спасибо!
Красиво все делает и время корректно отображается и могу менять интервал от 5 секунд до минуты. Уже могу продолжать работу.
Спасибо!
Я понимаю, что это наглость, но для полного счастья осталось решить вопрос с строками-дубликатами, а то их уйма.
И еще я хотел поинтересоваться, возможен ли вариант когда время представляется в секундах. Т.е. время отображается в секундах и при этом каждая последующая строка суммируется с предыдущей. Если у меня интервал 10 секунд, то в следующей строке должно быть 20, и т.д 30, 40, 50, 60, 70, 80.....
Еще раз спасибо, Вы мне очень помогли.
Автор: Anton T
Дата сообщения: 06.09.2006 12:48
Yuk

Цитата:
Пришли, в какой конкретно строке вылетает.

Если надстройки сделан, то нажимаем на кнопке Добавить запись или Найти записи выдает строку AddForm.show или FForm.show, сооветственно.
Автор: Yuk
Дата сообщения: 06.09.2006 19:47
Anton T
Проблема вот в этой строке:
Код: ComboBox1.Text = ThisWorkbook.ActiveSheet.Name
Автор: ZORRO2005
Дата сообщения: 06.09.2006 22:29
Yuk

Цитата:
Подразумевается, что данные в 1-м столбце А начиная со 2-й строки. (Первую строку на заголовок.) Исходные данные в листе 1-3, 4-и лист должен существовать. В общем, если что не работает, пиши конкретно где что.


Спасибо большое за макрос
а как сделать,чтобы не было разделений по РЕГИСТРУ?
Получается вот так:
BUNKER Buda 5
Bunker Buda 5

CONVERSE 1U165
Converse 1U165

Надо чтобы выбиралось что-нибудь одно.
Допустим только так:
BUNKER Buda 5
CONVERSE 1U165
---------------------------
P.S.
Если сортировать через сводную таблицу или консолидацию то получается
Bunker Buda 5
Converse 1U165

но с твоим макросом эфектнее


Страницы: 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768

Предыдущая тема: Стоит ли переходить с Билдера на Делфи?


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