» Excel VBA (часть 2)

Oygerможно маленький пример (с кодом), я не понимаю

q1wed

Цитата:

Есть прекрасный оператор Select

Вот спасибо тебе за помощь и терпение, что все таки вдолбил мне этот метод. Действительно, намного проще и делать и просматривать Пошел дальше копаться в мире макросов

MaximuS G

Код: For i = 1 to 4
arr(i)=replace(arr(i),"/","-")
Next

Solenaja

Цитата:

а можете ткнуть носом куда вставлять, что-то не соображу и закрывать Ifы где?

да легко :-)
только проверять Вам ;-)
[more=опять программка целиком]
мне кажется, что целиком код кинуть Вам будет понятнее.. ;-)

Код: [no]
Sub AddZero()
Dim i&, FirstRow&, LastRow&, p1&, p2%
Dim Cur_Cell_Type As String, s As String, sbstr As String
Dim WasChanged As Boolean
' Dim r As Range

FirstRow = ActiveWorkbook.ActiveSheet.UsedRange.Row
LastRow = FirstRow + ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count - 1

' как вариант можно пройтись только по выделенным
' For Each r In Selection
For i = FirstRow To LastRow
If Not IsEmpty(Cells(i, "A")) Then
Cur_Cell_Type = TypeName(Cells(i, "A").Value)
If (Cur_Cell_Type = "String") And (Len(Trim(Cells(i, "A").Value)) > 1) Then
s = Trim(Cells(i, "A").Value) + "-" ' временно добавим '-' в конец, потом удалим
p1 = 1
p2 = InStr(p1, s, "-")
WasChanged = False
While p2 > 0
' MsgBox "p1 = " & p1 & " substr= " & Mid(s, p1, p2 - p1)
sbstr = Mid(s, p1, p2 - p1)
If (Len(sbstr) = 1) And (val(sbstr) > 0) Then
s = Mid(s, 1, p1 - 1) & "0" & sbstr & Mid(s, p2)
p2 = p2 + 1 ' потому как строчку раздвинули на один символ!
WasChanged = True ' отметим, что мы меняли текст
End If
p1 = p2 + 1
p2 = InStr(p1, s, "-")
Wend
if inStr(1,s,"'")<>1 then s = "'" & s
If WasChanged Then Cells(i, "A").Value = Mid(s, 1, Len(s) - 1)
End If
End If
Next i
End Sub
[/no]

Oyger
Вообщем сделал следующим образом:
1. Вставляю список из Ворда в Эксель
2. При помощи =СЛЧИС() и сортировки смешиваю список
3. Выполняю склейку списка из множества ячеек в одну

Код: Sub Skleyka()
Dim i As Integer, t As String
t = ""
For i = 11 To 300
t = t & Chr(10) & Cells(i, 1).Value
Next
Range("A1").Value = t
End Sub

dneprcomp
Спасибо

SERGE_BLIZNUK
есть ещё одна коварная задача
данный полученный код товара нужно потом будет преобразовать в такой вид
[more]исходный код
01
01-01
01-01-1
01-01-1-01
01-01-1-02
01-01-1-03
01-01-2
01-01-2-1
01-01-2-2
01-01-2-3
и т.д.

результат
01;01-01;01-01-1;01-01-1-01
01;01-01;01-01-1;01-01-1-02
01;01-01;01-01-1;01-01-1-03
01;01-02;01-01-2;01-01-2-1
01;01-02;01-01-2;01-01-2-2
01;01-02;01-01-2;01-01-2-3
и т.д.
это нужно для создания папок\подпапок\ для каждого кода[/more]

Добрый день, уважаемые специалисты. Помогите записать простое условие в макрос:
При двойном нажатии на ячейку А1, ячейка A2 окрашивается в цвет(ячейка, а не символы в ней). При этом через 10 сек. ячейка A2 опять становиться бесцветной(как вариант - окрашивается в белый цвет). Спасибо

Добавлено:
Кстати, еще простой, но назойливый вопросик: Можно ли отогнать назад результат проведенного макроса?

Pravoved90

Цитата:

Кстати, еще простой, но назойливый вопросик: Можно ли отогнать назад результат проведенного макроса?

Сделай копию файла, перед запуском макроса /улыбается/

Добавлено:
q1wed

Цитата:

можно маленький пример (с кодом)

Можно. Только прошу за оффтоп не считать.
Предположим у тебя в Ворде есть таблица с 2 столбцами (слева - вопрос, справа - ответ). И с 10 строками (10 вопросов).
Задача и так ясна.
Пишем макрос в ворде:

Dim Ma(1 To 10, 1 To 2) As String 'Создаем массив 10х2
for q=1 to 10'Ставим цыкл для заполнения массива
ActiveDocument.Tables(1).Cell(q, 1).Select 'Выбираем первую ячейку таблицы в q-строке (запись cells - как в экселе)
Ma(q,1)=Selection.Text 'Заносим в 1х1 (а далее 2х1, 3х1...) вопросы - все, что содержится в ячейке таблицы
Selection.MoveRight Unit:=wdCell 'Выделяем следующую ячейку - кнопка "таб"
Ma(q,2)=Selection.Text 'Заносим в 1х2 (а далее 2х2, 3х2...) ответы - все, что содержится в ячейке таблицы
next

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

Pravoved90
Действия макросов в общем случае не отменяются!
Как отменить действия совершённые макросом ?

---

Solenaja
вопрос по "коварной" задаче - нужно получить подобный список отдельно (если да - то где предпочтительнее)?
если нет. тогда на что нужно заменить строчку с кодом "01"
или строчку "01-01" ???!

SERGE_BLIZNUK
Спасибо за ответ.Я так и думал)...

Подскажите, что не так в этом макросе: Если использую функцию If - работает норамльно, а если - Select case - не хочет
Мои примеры:
1. С if(работает)
If Not Intersect(Target, Range("D1")) Is Nothing Then
Application.EnableEvents = False
If ([D4] > 0) And ([D4] < 50) Then
Select Case Range("D30").Value
Case "слово"
Sheets("1").Range("D10").Value = Sheets("1").Range("D10").Value + 1
MsgBox (1)
Sheets("2").Range("E10").Value = Sheets("2").Range("E10").Value + 1
MsgBox (2)
Case "слово2"
Sheets("1").Range("D10").Value = Sheets("1").Range("D10").Value + 1
MsgBox (3)
Sheets("1").Range("F10").Value = Sheets("1").Range("F10").Value + 1
MsgBox (4)
End Select
End If
Application.EnableEvents = True
End If


С Selectcase(не работает):

If Not Intersect(Target, Range("D1")) Is Nothing Then
Application.EnableEvents = False
Select Case Range("D30").Value
Case ([D4] > 0) And ([D4] < 50)
Select Case Range("D30").Value
Case "слово"
Sheets("1").Range("D10").Value = Sheets("1").Range("D10").Value + 1
MsgBox (1)
Sheets("2").Range("E10").Value = Sheets("2").Range("E10").Value + 1
MsgBox (2)
Case "слово2"
Sheets("1").Range("D10").Value = Sheets("1").Range("D10").Value + 1
MsgBox (3)
Sheets("1").Range("F10").Value = Sheets("1").Range("F10").Value + 1
MsgBox (4)
End Select
End Select
Application.EnableEvents = True
End If

Подскажите, как правильно записать с Selectcase.

Добавлено:
Еще маленький вопросик:
Как правильно записать под это же условие:
Если ([D4] > 50) And ([D4] < 90), выполнить "новое условие", а также выполнить предыдущее ([D4] > 0) And ([D4] < 50). И так по возрастающей.

Конечно можно переписывать предыдущие условия, но это волокита, и не очень практично, если вариантов много. Думаю, есть более простое решение? Спасибо

SERGE_BLIZNUK

Цитата:

вопрос по "коварной" задаче - нужно получить подобный список отдельно (если да - то где предпочтительнее)?

это не принципиально, можно на новом листе
рассказываю чуть более подробнее.
после того как будут сформированные таким образом строки, файл сохраняется как csv или txt.
далее с ним работает программа Folder Maker (http://www.skyjuicesoftware.com) чтобы создать папки и вложенные подпапки.

вопрос.
можно ли скриптом создать папки и вложенные папки на осноании этих кодов средствами Excel?
[more]корневой каталог
01 - подгруппа, входящая в корневой каталог
01-1 - подгруппа, входящая в подгруппу 01
01-1-01 - подгруппа, входящая в подгруппу 01-1
01-1-01-01 - подгруппа, входящая в подгруппу 01-1-01
01-1-01-02 - подгруппа, входящая в подгруппу 01-1-01
01-1-01-03 - подгруппа, входящая в подгруппу 01-1-01
и т.д.

в итоге получим директорию с двадцатью папками от 01 до 20[/more]

Добрый день!

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

как то сложно получилось с описанием буду признателен, за помощь!

Oyger Спасибо

Добрый вечер. Еще один скромный вопрос: Как сделать, чтобы в MsgBox отображались быквы? Цифры отображаються, а если напишу букву - MsgBox вылетает пустой..

Pravoved90
MsgBox "asdfg"

dneprcomp
Спасибо. Ставил скобки)) Подскажите, кто знает ответ на мои вопросы немного выше))..

Pravoved90

Код: Select Case Range("D30").Value
Case ([D4] > 0) And ([D4] < 50)

dneprcomp
Спасибо за ответ

мой вопрос не решаемый ?


Цитата:

Добрый день!

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

как то сложно получилось с описанием буду признателен, за помощь!

Stupido

Вопрос решаемый ...
Если просто "натолкнуть на мысль" то вот:

1) Создаем 2 массива на основе исходного интервала с текстовыми значениями через

Код:
A=Range(Cells(1-ая строка, 1-ый столбец),Cells(послед. строка, послед. столбец))
B=Range(Cells(1-ая строка, 1-ый столбец),Cells(послед. строка, послед. столбец))

ecolesnicov

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

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

Добавлено:
Кстати, к вопросу о отмене действий макроса - может есть какая-то функция\програмка по созданию противоположных макросов?(например: макрос А1 +1, превратить в А1 -1 )

Pravoved90

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

Цитата:

как заставить каждую копию ячейки становиться за последней ячейкой(столбиком)

Пора и самому что-то пытаться сделать. Посмотри предыдущие ответы для тебя - там все есть.

Цитата:

For r=1 to Ubound(A,1)
ind=False
For i=1 to Ubound(C,1) '<====================== Type mismatch; Error (13)
For j=1 to Ubound(C,2) -1
If A(r,1)=C(i,j) then
B(r,1)=C(i,Ubound(C,2))
ind=True
Exit For
end if
next j
If ind=True then Exit For
next i
next r

cтранно, но в этой строчке вот такая ошибка выскакивает. Не могу понять - почему.

Oyger
Но я же только учусь))...Я вобще 2 недели назад ексель только для калькулятора открывал)). А спрашивал сам принцип, как раз, чтобы больше не обращаться за каждым примером..Но и на добром слове спасибо.

Pravoved90

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

'Сначала подключи библиотеку "Microsoft Scripting Runtime" (В VB меню Tools -> References)
Dim fs As New FileSystemObject
fs.CopyFile "ХХХ", "УУУ" 'ХХХ - полный путь и имя файла, который копируешь. УУУ - полный путь и имя файла, который будет резервным.

А копировать сами данный или писать модуль для отката макроса - бред... Хотя если у тебя много лишнего времени...

Stupido
сделай пример и выложи ссылку, только с подробными комментариями...
самому интересно
Кстати может кто знает есть ли команда подобная SHELL только что бы не запускать приложения, а наоборот закрывать.. или может какой то другой вариант ? Спс

MaximuS G

вот мой вариант на основе предложенного ecolesnicov
, но я его ещё не довёл до ума, вылетает с ошибкой http://forum.ru-board.com/topic.cgi?forum=33&bm=1&topic=8273&start=2500#16

[more]
Sub Macro1()
'
' Macro1 Macro
'

A = Range("b2:j25")
B = Range("b2:j25")

Workbooks.Open ("E:\!RABOTA\Excel\data.xls")


&#209; = Range("a2:k6")


For r = 1 To UBound(A, 1)
ind = False
For i = 1 To UBound(C, 1)
For j = 1 To UBound(C, 2) - 1
If A(r, 1) = C(i, j) Then
B(r, 1) = C(i, UBound(C, 2))
ind = True
Exit For
End If
Next j
If ind = True Then Exit For
Next i
Next r

Workbooks("E:\!RABOTA\Excel\data.xls").Close SaveChanges:=False

Range(Cells(b2), Cells(j25)) = B

Erase A, B, C

End Sub
[/more]

Stupido
нее, не так... я имел ввиду файлы