*VBA* | Помогите написать макросы для Excel'я

[Graers]

Народ, Подскажите как разрешить ситуацию:
на одном из листов сохранен запрос к фоксовской базе -строка SQL : Select * from...
Прописан макрос меняющий команду (в цикле) SQL на update , предположим.
Если в свойствах запроса на листе ставить"фоновое обновление"
то каждый раз доходя до строки кода где переопределяется commandtext выскакивает ошибка "данная операция не дрпускается во время фонового обновления", если в свойствах запросаа опцию ФО убрать, то VBA ругается на отсутствие объекта, причем опять же при изменении commandtext

[Margarittka]

Народ! Помогите кто может!
мне нужен макрос в VBA который копировал бы фамилии на листы, имя которых бы совпадало с первой буквой фамилии.
Например: "Иванов" - в лист "И", "Петров" - в лист "П".
Очень нужно!
Помогите пожалуйста!
Заранее спасибо!

[Codru]

Margarittka, Вам нужно чтобы фамилии оставались и на первом листе или устраивает, чтобы после набора первой буквы, осуществился переход на требуемый лист?

[Admiral]

Margarittka, алфавитные листы можно создать тоже с помощью макроса
Option Base 1
'...
Dim RussianLetters(33) As String
RussianLetters(1) = "Аа"
RussianLetters(2) = "Бб"
RussianLetters(3) = "Вв"
RussianLetters(4) = "Гг"
RussianLetters(5) = "Дд"
RussianLetters(6) = "Ее"
RussianLetters(7) = "Ёё"
RussianLetters(8) = "Жж"
RussianLetters(9) = "Зз"
RussianLetters(10) = "Ии"
RussianLetters(11) = "Йй"
RussianLetters(12) = "Кк"
RussianLetters(13) = "Лл"
RussianLetters(14) = "Мм"
RussianLetters(15) = "Нн"
RussianLetters(16) = "Оо"
RussianLetters(17) = "Пп"
RussianLetters(18) = "Рр"
RussianLetters(19) = "Сс"
RussianLetters(20) = "Тт"
RussianLetters(21) = "Уу"
RussianLetters(22) = "Фф"
RussianLetters(23) = "Хх"
RussianLetters(24) = "Цц"
RussianLetters(25) = "Чч"
RussianLetters(26) = "Шш"
RussianLetters(27) = "Щщ"
RussianLetters(28) = "Ъъ"
RussianLetters(29) = "Ыы"
RussianLetters(30) = "Ьь"
RussianLetters(31) = "Ээ"
RussianLetters(32) = "Юю"
RussianLetters(33) = "Яя"

For i = 1 To 33
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = RussianLetters(i)
Next i
я знаю, что некоторые фамилии не могут начинаться с некоторые буквы, показан всего лишь наглядный пример работы с массивом в VBA
Codru, я так понял, что список уже есть, по выполнению требуемого VBA макроса должно происходить копирования и сортировка по листам.

[Margarittka]

Спасибо Admiral и Codru за помощь!!!!!!
Мне действительно нужно, чтобы фамилии оставались и на первом листе.
SOS!!!
Кто может-помогите!!!
Заранее спасибо!!!!!!!!!

[azbest]

Может вам попробовать всё это разместить на одном листе - 65535 строк это ведь много. Просто упорядочить общий список пофамильно. И сделать макрос по поиску нужной фамилии в общем списке, добавлению новой фамилии, удалению ненужной фамилии, импорту нового списка в общий список, "защиту" от ошибок, пустых строк и тд? Что Вы дальше будете делать с рассртированными по листам фамилиями на каждом листе, или Вам достаточно их раскидать по алфавитным листам - а дальше трава не расти?

[Margarittka]

Нужно просто рассортировать

[Gerdewski]

Возможно нужное решение в прикреплённом файле

[Admiral]

Gerdewski, всё работает. На листах Б и Д расположены лишние кнопки "Очистить листы" и "Раскопировать" соответственно.

[Gerdewski]

На листах Б и Д расположены лишние кнопки "Очистить листы" и "Раскопировать" соответственно. »
понятия не имею откуда они там взялись. :)
Видимо в "формате объекта" (кнопки) на закладке "свойства" нужно поставить галку "не перемещать и не изменять размеры".

[azbest]

Я тоже его поробовал раскопировать. В конце получил вопрос - В буфере имеется большой список данных - сохранить его? Это при одном единственном столбце в Листе1. А если столбцов будет к примеру - 32 с разными данными? Попробуйте поэкспериментировать - Незабуксует программа? :blink:
Можно попробовать ещё вот так:

Sheets(1).select
s=Cells(1,1).currentregion.rows.count
for i=1 to s-1
sheets(1).select
Cells(i,1).select
FF=activecell.value
L=Left(Cells(i,1),1)
Sheets(L).select
Selection.insert Shift:=xldown
Activeceell.value=FF
next i
msgbox("Конец")

[Pliomera]

Option Base 1
'...
Dim RussianLetters(33) As String
RussianLetters(1) = "Аа"
RussianLetters(2) = "Бб"
RussianLetters(3) = "Вв"
RussianLetters(4) = "Гг"
RussianLetters(5) = "Дд"
RussianLetters(6) = "Ее"
RussianLetters(7) = "Ёё"
RussianLetters(8) = "Жж"
RussianLetters(9) = "Зз"
RussianLetters(10) = "Ии"
RussianLetters(11) = "Йй"
RussianLetters(12) = "Кк"
RussianLetters(13) = "Лл"
RussianLetters(14) = "Мм"
RussianLetters(15) = "Нн"
RussianLetters(16) = "Оо"
RussianLetters(17) = "Пп"
RussianLetters(18) = "Рр"
RussianLetters(19) = "Сс"
RussianLetters(20) = "Тт"
RussianLetters(21) = "Уу"
RussianLetters(22) = "Фф"
RussianLetters(23) = "Хх"
RussianLetters(24) = "Цц"
RussianLetters(25) = "Чч"
RussianLetters(26) = "Шш"
RussianLetters(27) = "Щщ"
RussianLetters(28) = "Ъъ"
RussianLetters(29) = "Ыы"
RussianLetters(30) = "Ьь"
RussianLetters(31) = "Ээ"
RussianLetters(32) = "Юю"
RussianLetters(33) = "Яя"
For i = 1 To 33
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = RussianLetters(i)
Next i »

Вместо всего выше написанного, достаточно просто:
For i = 1 To 32
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Chr$(i + 191) & Chr$(i + 223)
Next i

[Admiral]

Pliomera, да конечно, но то наочние для новичков, которые ещё не знают про Chr$, а про массивы уже знают.

[Aizec]

Доброго времени суток всем присутствующим.
Кто-нибудь может помочь с такой проблемкой:
Есть две книги file1 и file2, каждая с двумя столбцами, первый из которых это идентификатор, второй - значения; вобщем надо значения из первой книги переместить во вторую (при совпадении ячеек из первого столбца). Я использовал следующий макрос, но работает он крайне медлено при большом количестве строк(понятно, при прямом переборе то). Вообщем, как можно более эффективно и быстрее это сделать?
i = 1
While Workbooks(file2).Worksheets("List").Cells(i, 1).Value <> ""
current = Workbooks(file2).Worksheets("List").Cells(i, 1).Value
j = 1
flag = False
Do While Workbooks(file1).Worksheets("List").Cells(j, 1).Value <> ""
If Workbooks(file1).Worksheets("List").Cells(j, 1).Value = current Then
flag = True
Exit Do
End If
j = j + 1
Loop
If flag = True Then
Workbooks(file2).Worksheets("List").Cells(i, 2).Value = Workbooks(file1).Worksheets("List").Cells(j, 2).Value
Workbooks(file2).Worksheets("List").Cells(i, 2).Interior.Color = RGB(0, 255, 0)
End If
i = i + 1
Wend

[Strange_V]

Aizec, ВПР?

[Aizec]

ВПР? »
Что это такое?

[Strange_V]

ВПР (http://office.microsoft.com/ru-ru/excel/HP052093351049.aspx) - это функция, точно не помню работает ли она с разными книгами, но думаю да.

[Aizec]

Strange_V Спасибо, но это не подходит - я ведь не знаю содержимого ячеек.

[azbest]

Если Вы не знаете содержимое ячеек, значит Вы не можете знать сколько раз может совпасть идентификатор из первого файла с перебираемыми идентификаторами во втором файле (если только идентификатор - это не числа по порядку). А у вас как только они совпадают (i,1).value = (j,1).value - происхлдит выход из цикла переборки и берётся следующий идентификатор из первого файла (i,1).
Кроме того у вас каждый раз при "exit Do" - рушится цикл переборки хотя текущий его счётчик "j" запоминается и далее уже при i = i+1 - снова создается новый Do ...Loop c запомненным "j", плюс ещё каждый раз происходит сравнение с "непустым" значением - проверка на конец списка.
Попробуйте вот так:

S1=Workbooks(file2).Worksheets("List").Cells(1, 1).currentregion.rows.count
S2=Workbooks(file1).Worksheets("List").Cells(1, 1).currentregion.rows.count
for x=1 to S1
idn1=Workbooks(file1).Worksheets("List").Cells(x, 1).value
for y=1 to S2
idn2=Workbooks(file2).Worksheets("List").Cells(y, 1).
if idn1=idn2 then
zn1=Workbooks(file1).Worksheets("List").Cells(x, 2).value
Workbooks(file2).Worksheets("List").Cells(y, 2).value=zn1
Workbooks(file2).Worksheets("List").Cells(i, 2).Interior.Color = RGB(0, 255, 0
end if
next y
next x

[Aizec]

azbest Спасибо.
И у меня еще один вопрос возник: как импортировать в Excel не весь текстовый файл, а только текст заключенный в кавычки ""? Потом его еще надо будет после перевода обратно вставить.