» Excel VBA (часть 3)

Доброе время, mrdime
Тут вопрос не в алгоритме сортировки, а в алгоритме сравнения. Расширенная идея от KDPoid.

Код:
Function IsAlphabetGreater(vStr1, vStr2)
Const cCharList = "АБВГҐДЕЁЄЖЗИІЇЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ"
Dim i, vChar1, vChar2, vCharCode1, vCharCode2, vOut
IsAlphabetGreater = False
For i = 1 To IIf(Len(vStr1) < Len(vStr2), Len(vStr1), Len(vStr2)) + 1
vChar1 = Mid(vStr1, i, 1)
vChar2 = Mid(vStr2, i, 1)
vCharCode1 = InStr(1, cCharList, vChar1, vbTextCompare)
vCharCode2 = InStr(1, cCharList, vChar2, vbTextCompare)
If (vCharCode1 = 0) Or (vCharCode2 = 0) Then
vCharCode1 = Asc(vChar1)
vCharCode2 = Asc(vChar2)
End If
If vCharCode1 <> vCharCode2 Then
If vCharCode1 > vCharCode2 Then IsAlphabetGreater = True
Exit For
End If
Next
End Function

Alex_Piggy
Огромное спасибо. То, что надо. Потестил код - работает безупречно.
Насчет апдейта: не совсем понял зачем добавлять сравнение длин.
Завтра на свежую голову попробую разобраться.

mrdime,
Предпоследний вариант был такой:
В цикле сравниваются символы до меньшей из длин строк.
Т.е. если строки
vStr1 = "АБВГДЕ"
vStr2 = "АБВ"
То сравниваться будут только первые три символа.
Они равны, и ответ функции "АНеБольшеЛи(vStr1,vStr2)" будет "Нет"

Добавленная проверка длины, это "Если общая часть строк одинакова, кто длиннее, тот и больше"

Еще вопрос.
Есть некий массив.
Как в макросе реализовать следующее:
если длина строки в ячейке столбца А =10, то в сооветствующей ячейке столбца B вписать "Город", иначе "Пригород". Продлить формулу на весь массив.
Пробовал делать через "Запись макроса", получилось как-то некрасиво - если длина столбца в массиве изменится, надо будет продлять или удалять формулы в B.

А зачем макросом-то? Обычной формулой! Для русского офиса: =ЕСЛИ(ДЛСТР(А1)=10;"Город";"Пригород")
Для макроса и массива это соответственно

Код: If len(элемент_массива) = 10 Then
Элемент_массива_2 = "Город"
Else
Элемент_массива_2 = "Пригород"
End If

lsd11
Ну и что такое "некий массив" и как он связан с ячейками? Такое мутное описание наводит на мысли, что под массивом понимается набор ячеек. В терминах VBA "массив" это не "набор ячеек".

Если некорректно поставил задачу, извиняюсь.
ZlydenGL
Цитата:

А зачем макросом-то?

Это не единоразовая работа. Каждый раз забивать формулы не очень целесообразно.
Проще написать кучу макросов (или один большой), чтобы сразу привести все в нужный вид по нажатию кнопки.
Alexzzy

Цитата:

Ну и что такое "некий массив" и как он связан с ячейками?

Массив - 15 столбцов, 10 000 строк
привожу пример, что у меня получилось (массив не тот, но принцип понятен):
массив вида:


Код: Sub к2()
ActiveCell.FormulaR1C1 = "=IF(LEN(RC[-7])=10,""Город"",""Пригород"")"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H4")
Range("H2:H4").Select
End Sub

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

Код:
Sub qweqwe()
i = 2 ' Начинаем со второй строки. В первой заголовки
While ActiveSheet.Range("A" + CStr(i)) <> "" ' Проверяем строки, пока в первом столбце что-то есть
ActiveSheet.Range("B" + CStr(i)).FormulaR1C1 = "=IF(LEN(RC[-1])=10,""Город"",""Пригород"")"
i = i + 1 ' переходим к следующей строке
End If
Wend
End Sub

KDPoid, спасибо!
только вылазит
Compile error:
En If without block If

P.S. Убрал в скрипте "End If", помогло.
А можно без заполнения формулой сделать?
P.P.S.

Код:
Sub qweqwe()
i = 2 ' Начинаем со второй строки. В первой заголовки
While ActiveSheet.Range("A" + CStr(i)) <> "" ' Проверяем строки, пока в первом столбце что-то есть
If Len(ActiveSheet.Range("A" + CStr(i))) = 10 Then ActiveSheet.Range("B" + CStr(i)) = "Город" Else ActiveSheet.Range("B" + CStr(i)) = "Пригород"
i = i + 1 ' переходим к следующей строке
Wend
End Sub

"Если делаешь добро рассчитывая на благодарность, то это не добро, а навязанная сделка".
Помогло, и хорошо.

Alex_Piggy
привет
глянь пожалуйста ПМ. ты мне очень помог с макросом но маленький недопил мешает его использовать.
спасибо.

Код: While ActiveSheet.Range("A" + CStr(i)) <> ""

Winand
Да, такое надо знать и использовать когда надо, но "конец данных" в общем случае не равен "концу значимых данных".

пожалуй, да. Тогда так: конец данных в отдельно взятом столбце

Код: Range("A" & Rows.count).End(xlUp).Row

Господа, такой вопрос.
Есть [more=программа]Attribute VB_Name = "Tanya_DBReserve"
Sub DBReserve()

Dim c As Integer
Dim r As Integer
Dim ra As Integer
Dim n As Integer
Dim AL(1 To 200, 1 To 2) As String
Dim i As Integer, j As Integer
Dim InNum As Integer

Dim myWb As Workbook
Dim mySh As Worksheet
Dim DocPath As String
Dim CurDate As String

Application.ScreenUpdating = False
DocPath = "c:\Temp\Tanya\Adm\Lists\DB"

CurDate = CStr(Date)
r = ActiveSheet.UsedRange.RowS.Count
i = 0

For n = 2 To r
If IsNumeric(Cells(n, 1).Value) And Cells(n, 1).Value > 0 Then
i = i + 1
For j = 1 To 2
AL(i, j) = Trim(Cells(n, 4 + 3 ^ (j - 1)).Value) + " " + Trim(Cells(n, 5 + 3 ^ (j - 1)).Value)
Next j
End If
Next n
Set myWb = Workbooks.Open(DocPath + "\" + "TotalList.xlsx")
myWb.SaveAs (DocPath + "\" + "TotalList_" + CurDate + "_reserve.xlsx")
myWb.Close
Set myWb = Workbooks.Open(DocPath + "\" + "TotalList.xlsx")
Set mySh = myWb.Worksheets("Sheet1_full")
mySh.Activate
ra = ActiveSheet.UsedRange.RowS.Count
InNum = Cells(ra, 1).Value
For n = 1 To i
Cells(ra + n, 1).Value = InNum + n
For j = 1 To 2
Cells(ra + n, j + 1).Value = AL(n, j)
Next j
Next n
Application.ScreenUpdating = True
MsgBox ("Программа завершилась успешно.")

End Sub
[/more], которая диапазон ячеек из одного файла загоняет в массив (по ходу объединяя содержимое 2 сосердних ячеек).
Потом делает резервную копию файла базы данных (БД в Excel) и дописывает в конец этой базы данных полученный на предыдущем этапе массив.После чего сохраняет файл базы данных (оставив его открытым, чтобы пользователь мог сразу визуально убедиться в правильности полученного результата)
В конце программы через MsgBox хочу вывести сообщение, что программа завершилась успешно.
НО, именно на этом этапе почему-то возникают проблемы. Окно MsgBox выводится почему-то не поверх открытого файла БД в который были дописаны данные из массива, а в окне редактора VBA. Т.е. в конце программы я получаю открытое активное окно с файлом БД и крутящееся "колесико" выполнения программы (до бесконечности). Когда по Alt-Tab перехожу в окно VBA то вижу сообщение из MsgBox о том что программа завершилась успешно. И только после того, как нажму Ок, программа завершается успешно.
Вопрос: как сделать так, чтобы окно MsgBox появлялось там, где я это ожидаю, а именно - в активном открытом окне файла БД, в который была произведена запись данных?
Почему так происходит (MsgBox выводится только в окне редактора VBA)?

а от куда вызывается скрипт? если честно то подзабыл немного VBA.. да и ещё вопрос почему в результате редактор VBA открывается, большинство скриптов по идее должно работать без нагрузки пользователей странными дополнительными окнами/интерфейсами..
только что перепроверил - у меня окна такого рода открываются в Excel (2013/64) а не редакторе VBA, но судя по тому что на предыдущем шаге ты работаешь на уровне Application... может переактивируй текущую страницу перед/после MsgBox типа ActiveSheet.Activate

vikkiv

Цитата:

а от куда вызывается скрипт?

Скрипт я вызываю из редактора VBA, но ИМХО это не должно иметь значения (откуда я его вызываю), т.к. по логике окно MsgBox должно выводиться поверх последнего активного онкна, а в моем коде последним активным окном является окно с открытым файлом базы данных Excel.

Цитата:

судя по тому что на предыдущем шаге ты работаешь на уровне Application...

Видимо это имеет значение.
Но ActiveSheet.Activate проблему не решает.

У меня Excel 2013 x86, но ИМХО версия сабжа в данном случае не должна иметь значения.
Добавлено
Нашел решение на stackoverflow заодно и решил проблему с отображением ненужных мне окон.
Кому интересно, сразу после открытия файла БД добавил строчку myWb.Windows(1).Visible = False. А в конце, после Application.ScreenUpdating = True выставил этот параметр (myWb.Windows(1).Visible) в True. Таким образом избавился от ненужного мелькания окон и добился вывода MsgBox по завершению работы программы поверх окна файла, в который вносились изменения.

Вопрос может кто помочь с макросом? Есть файл Excel 2007 следующего вида.

А1 В1 0
А2 В2 0
А3 В3 1
А4 В4 0

Необходимо после работы получить три текстовых файла следующего содержания.
Первый:
А1:CL:B1 A2:CL:B2 A3:CL:B3 ....

Второй:
A1,A2,A4

Третий:
А3

Небольшое пояснение по второму и третьему файлу. Если в третьем столбце 0, то значение ячейки в первом столбце передается в один файл, иначе в другой.

Вроде бы, всё интуитивно понятно, и дополнительных комментариев не требует

Код:
Sub qweqwe()
S1 = ""
S2 = ""
S3 = ""
i = 1
While ActiveSheet.Range("A" + CStr(i)) <> ""
S1 = S1 + ActiveSheet.Range("A" + CStr(i)) + ":CL:" + ActiveSheet.Range("B" + CStr(i)) + " "
If ActiveSheet.Range("C" + CStr(i)) = 0 Then
S2 = S2 + ActiveSheet.Range("A" + CStr(i)) + ","
Else
S3 = S3 + ActiveSheet.Range("A" + CStr(i)) + ","
End If
i = i + 1
Wend
Open ActiveWorkbook.Path & "\1.txt" For Output As 1
Print #1, Left(S1, Len(S1) - 1)
Close 1
Open ActiveWorkbook.Path & "\2.txt" For Output As 2
Print #2, Left(S2, Len(S2) - 1)
Close 2
Open ActiveWorkbook.Path & "\3.txt" For Output As 3
Print #3, Left(S3, Len(S3) - 1)
Close 3
End Sub

KDPoid
Увы, выдает ошибку

Код: Runtime error "13":
Type mismath

Ну раз в столбце B - числа, понятно почему VBA несколько растерялся от идеи прибавить к строке число...

Для ваших данных строку
S1 = S1 + ActiveSheet.Range("A" + CStr(i)) + ":CL:" + ActiveSheet.Range("B" + CStr(i)) + " "
замените на
S1 = S1 + ActiveSheet.Range("A" + CStr(i)) + ":CL:" + CStr(ActiveSheet.Range("B" + CStr(i))) + " "

Спасибо большое, все отработало на "5".
Там вроде формат ячейки выставлен как "Текстовый". Или ему это не сильно интересно?

Практика показала, что ему пофиг
Мне при открытии оно в столбике B даже показало 555.0
Ноль потом спрятало, но как к тексту, к содержимому относиться не стало...

Вот жеж... еще раз спасибо.

Добавлено:
Начал дорабатывать под себя и получаю

Код: Invalid procedure call or argument

Вы убрали столбик 0-1 в E
В коде анализируется столбик C
Как результат, в S2 - ничего нет.
тогда
Print #2, Left(S2, Len(S2) - 1)
Это "Напечатать во второй файл, -1 символ слева из S2"...

Надо изменить
If ActiveSheet.Range("C" + CStr(i)) = 0 Then
на
If ActiveSheet.Range("E" + CStr(i)) = 0 Then

Ну и вывод во всех трёх файлах сделать как-нибудь так:
if S2 <> "" then
Open ActiveWorkbook.Path & "\2.txt" For Output As 2
Print #2, Left(S2, Len(S2) - 1)
Close 2
end if

Блин действительно глупейшая ошибка. Пошел переделывать. Еще раз спасибо.

подскажите можно ли реализовать следующие каким нибудь кодом или скриптом :



суть в том что есть таблице в эксель файлы пронумерованные от 420 до 1300 и идут цифры в произвольном порядке в каждой строчке от 1 до 3, как найти полностью противоположные строчки каждой строчки, условие такое что 1 и также строчка не может встречаться дважды, в ручную все занимает много времени .

На рисунке пример что 269 строчка полностью противоположна 531 и 574,а 270 полностью противоположна 819 и 106

DJMC
а "полностью противоположна" это как?

Судя по картинкам, нужно найти две строки, у которых в каждой ячейке значения не равны (отличаются) значениям в соответствующей ячейке контрольной строки?

NeNeZ

Цитата:

а "полностью противоположна" это как?

ну как на картинке зная все цифры в 269 строчке, найти другие строчки где этих цифр нет

Цитата:

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

Можно.