» Excel VBA

Pantera3587
Так?

Код:
Sub rrr()
Range("a1", "b1").CurrentRegion.Copy Sheets(2).Range("B1")
End Sub

Здравствуйте!

Есть вот такой дико неправильный код:

Range("B1:H1").Select
selection.Copy
Range("I1").Select
selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

А задача состоит в следующем: через каждые 10 строк в столбцах B:H содержатся некие данные, которые нужно вставить в транспонированном виде в соответствующую строку в столбце I.
Я пытался реализовать сие через что-то типа For r=1 to 500 step 10 и т.д., но ничего не получилось )))
Помогите, пожалуйста.

SERGE_BLIZNUK

Цитата:

Ая-яй... А неужели проверить сложно? я вот тоже не знаю, как оно в теории будет, но, проверил - в одной процедуре делаешь open.. as 2, в другой - print #2 (причём вызывал её несколько раз) на закрытие книги - Close #2 всё работает...

Сделал по другому - передаю номер
Open ... As 2
Call mysub(parms,2)
sub mysub (parms, Nbr As integer)
print #Nbr .....

Работает

Anton T
Данные на листе отсортированы? По фамилии? Сортировка допустима? - Это позволит не проходить по всему листу (тем более - через цикл), а сразу перейти к первому совпадению (если совпадение есть) и идти от него вниз.

Добавлено:
Возник вопрос - как на пользовательский тулбар (не форму!) скриптом добавить: CheckBox и ToggleButton. Вообще, такое возможно? И если не возможно, то какие есть обходные маневры. Что-то я с утра туго соображаю...

Добавлено:
crewgehr
попробуй спросить в теме по Excel. Это делается без VBA:
1. Задаешь диапазон формулой.
2. Создаешь формулу массива. {=ТРАНСП(заданный_диапазон)}
Вот только сам я в диапазонах (Именах) и формулах массивов разбираюсь слабо и точную формулу диапазона сказать не могу.

The okk
Цитата:

Цитата: что я делаю не так?

Используешь версию 2003

The okk

Цитата:

Возник вопрос - как на пользовательский тулбар (не форму!) скриптом добавить: CheckBox и ToggleButton.

По поводу ToggleButton: насколько представляю добавлять нужно обыкновенную кнопку (Type:=msoControlButton), и в нужный момент менять ее свойство State.
С CheckBox как быть не знаю, но, в крайнем случае, можно выкрутиться выполнив его в виде той же кнопки, подобрав подходящую иконку (в виде галки).

SERGE_BLIZNUK
А, точно. Нашел. Спасибо!
В общем, чтобы сделать из ##/## ##/##:
Код:
Cells(1,1).Characters(Start:=4, Length:=2).ColorIndex = 3

crewgehr
Цитата:

через каждые 10 строк в столбцах B:H содержатся некие данные, которые нужно вставить в транспонированном виде в соответствующую строку в столбце I.

ну, раз вы в этом форуме спросили - получите программку ;-))

Код:
Sub MyTranspose()
cB = 2
cH = 8
cI = 9
Row1 = ActiveWorkbook.ActiveSheet.UsedRange.Row
Row2 = Row1 + ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count - 1
For i = Row1 To Row2 Step 10
If Not IsEmpty(Cells(i, cB)) Then
For j = cB To cH
Cells(i + j - cB, cI).Value = Cells(i, j).Value
Next j
End If
Next i
End Sub

Интересная задача появилась на Daily Dose of Excel.
Смысл сводится к тому, чтобы для двух строк подобрать наиболее подробный шаблон/маску. Например, есть два слова: "предприятие" и "предприниматель", для них наиболее подробный шаблон будет по идее: "предпри*т*". Но тот алгоритм, что там реализован, сверяет только символы в совпадающих позициях (т.е. первый с первым, второй со вторым и т.д.), что приводит к тому, что шаблон для слов "правильный" и "неправильный" вообще нулевой, хотя должен быть "*правильный". Если у кого какие мысли - высказывайтесь.

The okk

Цитата:

Наверное, вот так...

Спасибо, что откликнулся на мой вопрос, но этот код почему-то не заработал, пишет, что не определен (выделяет желтым цветом) следующую строку
Worksheets("Лист2").Range(Cells(1, 1), _
Cells(lRowsCount, lColCount)) = .UsedRange
А вот код Anton T заработал. Большое спасибо.

The okk

Цитата:

для чекбокса надо еще иметь и значок без галки

ну так ручки же есть - самому нарисовать и через свойство Picture прицепить. можно и маску использовать (свойство Mask).
Как сделаешь - выложи код.

Если кто знает другой способ - пишите.

The okk

Цитата:

для двух строк подобрать наиболее подробный шаблон/маску

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

to SERGE_BLIZNUK & The okk

Большое спасибо - всё работает.

Отдельное спасибо SERGE_BLIZNUK за весьма познавательную ссылку.

есть лист на котором очень часто встречается примерно такая формула

Код:
='C:\Temp\[Финдонесение январь 2007 г.1.xls]15'!$F$9-'C:\Temp\[Финдонесение январь 2007 г.1.xls]15'!$G$9-'C:\Temp\[Финдонесение январь 2007 г.1.xls]15'!$H$9-'C:\Temp\[Финдонесение январь 2007 г.1.xls]15'!$K$9+'C:\Temp\[Финдонесение январь 2007 г.1.xls]15'!$Q$9

The okk

Цитата:

Если у кого какие мысли

Детально довести нет времени, но идея такова - в цикле отнимаем по одной букве спереди и сзади и делаем InStr пока не нашли маску

For bgn = 1 to len(txt2)
for ln = len(txt2) to bgn step -1
SearchTxt=Mid(Txt2,bgn,ln)
If InStr(Txt1,SearchTxt)>0 then
Go To GotMask
end if
next ln
next bgn

mask=""
goto NoMask
GotMask:
mask=Left("***********",bgn-1) & SearchTxt & Left("**********",len(txt2)-ln+1)
NoMask:

Yuk

Цитата:

Времени мало, да и нафиг это нужно, разве что развлечения ради

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

ShIvADeSt

Цитата:

Как сделать, чтобы при копировании этого листа на имя 16

Вот эту фразу я не понял... Что значит "копирование листа на имя 16"? Какой лист, откуда копируется и куда копируется?

vzbzdnov
Такой алгоритм найдет только 1 общий кусок для двух строк. Маску типа file?name для file1name и file2name ему не одолеть.
При всей кажущейся элементарности задачи алгоритм, если начать разбираться, не так очевиден.

Troitsky

Цитата:

ну так ручки же есть - самому нарисовать

Самому лениво

Цитата:

можно и маску использовать (свойство Mask).

Как это облегчит задачу?

Цитата:

Как сделаешь - выложи код.

Ок.
Что-то не пойму, как тут на OnAction прописать вызов процедуры с параметром? Класс для кнопок что ли создавать
Но что писать в модуле класса? - Ведь у кнопок на тулбаре нет события Click и способ, который существует для кнопок формы (создать класс кнопок) не подойдет. Простейшая на первый взгляд задача оказалась не такой простой... "Все не только не так просто, но и просто не так"
Решил сделать слева тулбар с настройкой видимости листов - поскольку их в проекте предполагается до 150, листать их все в поисках нужного довольно нудно. Скрипт, создающий панель я сделал:
Код: Sub AddVisibilityToolBar()
Dim msBtn As CommandBarButton
Dim wsList As Worksheet
'перерисовка панели
On Error Resume Next
Application.CommandBars("VisibilityToolBar").Delete
On Error GoTo 0
Application.CommandBars.Add(Name:="VisibilityToolBar").Visible = True
'ставим её слева
With Application.CommandBars("VisibilityToolBar")
.Position = msoBarLeft
'для каждого листа добавляем кнопку
For Each wsList In Worksheets
With .Controls
Set msBtn = .Add(Type:=msoControlButton)
With msBtn
.FaceId = 643
'на каждой кнопке пишем название соотв. листа
.Caption = wsList.Name
.Style = msoButtonWrapCaption
'если лист видим, кнопка нажата и наоборот
.State = wsList.Visible
End With
End With
Next wsList
End With

End Sub

The okk
Привет! Тебе сделал командная панель:

Код:
Public cmb As CommandBarComboBox

Public Sub ActWs() 'Активация листа
Worksheets(cmb.List(cmb.ListIndex)).Activate
End Sub

Public Sub CreateComboBox()
Dim cb As CommandBar
Dim ws As Worksheet

' Удаление существующей панели инструментов Temp
On Error Resume Next
Application.CommandBars("Temp").Delete
On Error GoTo 0

' Добавление пустой панели инструментов
Set cb = Application.CommandBars.Add(Name:="Temp", Temporary:=True)

' Добавление ComboBox и раскрывающегося меню
Set cmb = cb.Controls.Add(Type:=msoControlComboBox)

' Проверяем все листы активной книге
For Each ws In ActiveWorkbook.Worksheets
cmb.AddItem ws.Name
Next ws

With cmb
.DropDownWidth = 100
.ListIndex = 1
.OnAction = "ActWs" 'Активация листа
End With

cb.Visible = True
End Sub

Цитата:

Такой алгоритм найдет только 1 общий кусок для двух строк

Тогда так

Цитата:

Function Mask(Txt1 As String, Txt2 As String) As String
Dim bgn As Integer, ln As Integer, pos As Integer, strt As Integer
Dim matchSw As Boolean, SearchTxt As String, s As String
Mask = ""
strt = 1
For bgn = 1 To Len(Txt2)
matchSw = False
s = Mid(Txt2, bgn)
For ln = Len(s) To 1 Step -1
SearchTxt = Mid(s, 1, ln)
pos = InStr(strt, Txt1, SearchTxt)
If pos > 0 Then
matchSw = True
Exit For
End If
Next ln
If matchSw Then
Mask = Mask & SearchTxt
bgn = bgn + Len(SearchTxt) - 1
strt = pos + Len(SearchTxt)
Else
Mask = Mask & "*"
End If
Next bgn
End Function

The okk

Цитата:

Цитата:Как сделать, чтобы при копировании этого листа на имя 16
Вот эту фразу я не понял... Что значит "копирование листа на имя 16"? Какой лист, откуда копируется и куда копируется?

Лист с формулой имеет имя 15 и ссылаетися в формуле на лист с соотв именем в другой книге (то есть на лист 15) надо чтобы при копироваании Листа с именем 15 в первой книге в имя 16, автоматически в формуле так же менялось имя листа во второй книге с 15 на 16.

vzbzdnov
Цитата:

Тогда так

красиво... почти работает!
Но есть косячок - отбрасывает символы в первой строке в начале и конце.
Например, для
"Мояпроба9999" и "проба" вернёт маску "проба"
и ещё, в середине неплохо было бы одиночные звёздочки заменять на "?" а все подряд идущие звёздочки - на одну звездочку. Но это тривиальная задача...

Anton T
Спасибо, но с комбобоксом проще - это один элемент управления, а тут надо было именно для нескольких контролов одну процедуру, но с разными параметрами.
На другом форуме подсказали:

Код: Sub AddVisibilityToolBar()
Dim msBtn As CommandBarButton
Dim wsList As Worksheet

On Error Resume Next
Application.CommandBars("VisibilityToolBar").Delete
On Error GoTo 0
Application.CommandBars.Add(Name:="VisibilityToolBar").Visible = True

With Application.CommandBars("VisibilityToolBar")
.Position = msoBarLeft
For Each wsList In Worksheets
With .Controls
Set msBtn = .Add(Type:=msoControlButton)
With msBtn
.Caption = wsList.Name
.Style = msoButtonWrapCaption
.State = wsList.Visible
.OnAction = "'MyMacro """ & .Caption & """'"
End With
End With
Next wsList
End With
End Sub

Sub MyMacro(wsName As String)
With Application.CommandBars("VisibilityToolBar").Controls(wsName)
.State = Not .State
End With
On Error Resume Next
With Worksheets(wsName)
.Visible = Not .Visible
End With
On Error GoTo 0
End Sub

SERGE_BLIZNUK

Цитата:

Но есть косячок - отбрасывает символы в первой строке в начале и конце.

Это не косяк. Просто не вполне понятно, как должно быть.
Я так понимаю, что маска "проба" означает, что всё слово целиком входит в "Мояпроба9999"
А, например, МАСК("Мояпро9ба9999","проба")="пр*ба", т.е. буква О никуда не входит
А МАСК("проба9999","Мояпроба")="***проба", т.е. первые 3 буквы никуда не входят

А как надо, чтоб был ответ?

vzbzdnov

Цитата:

А как надо, чтоб был ответ?

Как в шаблоне поиска файла. Там именно для этого такая функция и задумывалась - вместо того, чтобы сохранять большую строку с именами, "законсервировать" их в шаблон. Неизвестное количество символов - *, один символ - ?
Т.е. МАСК("проба9999","Мояпроба")="*проба*"

Добавлено:
Массив констант в VBA не задается?

The okk

Цитата:

Цитата: ну так ручки же есть - самому нарисовать

Самому лениво

Troitsky

Цитата:

Кстати, можно с использованием WinAPI попробовать такое провернуть, но только оправдан ли будет этот геморрой.

Я WinAPI не юзаю - нет у меня таких задач.

Цитата:

никак не облегчит, но смотреться цивильнее будет.

А для маски все равно нужно рисунок создавать? Я маской никогда не пользовался.
Пример есть?

Цитата:

тогда уж не забудь обрабатывать добавление в книгу новых листов и их переименование.

Это понятно. А вот что делать при удалении? Есть какое-то событие, отвечающее за удаление листа?

Подскажите, как суммировать данные в колонке: к примеру каждую четвертую строчку.

aks_sv
Цитата:

Подскажите, как суммировать данные в колонке: к примеру каждую четвертую строчку.

Вы уверены, что вам нужно решение именно на VBA (макрос)?
извольте...

Код:
Row1 = ActiveWorkbook.ActiveSheet.UsedRange.Row
Row2 = Row1 + ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count - 1
col1 = Selection.Column
Sum1 = 0
For i = Row1 To Row2 step 3
If TypeName(Cells(i, col1).Value) = "Double" Then
Sum1 = Sum1 + Cells(i, col1).Value
End If
Next i
MsgBox "Summa = " + Str(Sum1)

ShIvADeSt
этот вопрос лучше задать в теме про Excel. По-моему, это должно решаться стандартными средствами через формулу =ЯЧЕЙКА
Ну, или похожую пользовательскую функцию состряпать, определяющую номер текущего листа:

Код:
Public Function (rngCell As Range) As Long
Application.Volatile
НОМЕР_ЛИСТА = rngCell.Worksheet.Index
End Function

Всем привет.
Есть такая проблема:
есть листы 1 2 3 print
заходим на print, а там кнопочка 1 2 3 жмём на неё и печатается соответсвующий лист.
Как такое реализовать ?

Заранее спасибо.

The okk

Цитата:

что делать при удалении? Есть какое-то событие, отвечающее за удаление листа?

Хм. Можно попробовать при возникновении события Workbook_SheetDeactivate выявить лист, который перестает быть активным, а при событии активации нового листа Workbook_SheetActivate проверить не удален ли тот, который мы только что покинули.

Цитата:

А для маски все равно нужно рисунок создавать? Я маской никогда не пользовался.
Пример есть?

Все тот же пример из шапки: http://webfile.ru/1286731
Посмотри какой результат с использованием маски, а какой - без ее использования.