» Excel VBA (часть 2)

Код: 1: If Sheets("Лист1").Range("A" & j) <> "" Then
j = j + 1
GoTo 1
Else
s = 0
s = j -2
ActiveCell.Value = "=AVERAGE(Архив!R[-1]C:R[s]C)"

Народ подскажите пожалуста. Может кто в курсе.
программа использует библиотекy AutoCAD/ObjectDBX Common 17.0 Type Library
VBA AUTOCAD работает в VBA EXCEL выдает ошибку типа- Не нейден указанный модуль. Библиотеки везде подключены. Очень еужно запустить ее по Excel


Sub NAMFIDWG()
Dim fan As String
Dim avt As String

fan = "c:\111.dwg"
Dim MainDoc As AXDBLib.AxDbDocument
Set MainDoc = New AXDBLib.AxDbDocument
MainDoc.Open (fan)

avt = MainDoc.SummaryInfo.LastSavedBy
MsgBox (avt)

Set MainDoc = Nothing

End Sub

Здравствуйте, уважаемые!

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

Цитата:

не смог выделить функции, которые отвечают за удаление

сюда

YuriySamorodov
удалить строку R целиком:
Rows(r).Delete
или
Cells(r, xxxx).EntireRow.Delete

ну вот, ПРИМЕРНО так:
Код:
lastrow = Cells(ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count, COL).End(xlUp).Row
' где col - номер нужного столбца
Application.ScreenUpdating = False
For r = LastRow To 2 Step -1
If Cells(r, 1) = Cells(r-1, 1) Then
Cells(r, 1).EntireRow.Delete
end if
Next r
Application.ScreenUpdating = True

SERGE_BLIZNUK
а мне не поможешь?

Solenaja
Если у Вас на листе 1 структура строго соблюдается, т.е. за строками, начинающимися с "Упр" и следующий "Не" обязательно будет присутствовать строка, начинающаяся с "Бух", то макрос очень простой:

Код: Sub Main()

Dim i As Long, j As Long
Sheets(1).Activate
With Sheets(2)
.Cells.ClearContents
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Left(Cells(i, "A"), 3) = "Упр" Then If Left(Cells(i + 1, "A"), 2) = "Не" Then a = i
If Left(Cells(i, "A"), 3) = "Бух" Then _
Rows(a & ":" & i).Copy .Cells(.Cells(Rows.Count, "A").End(xlUp).Row + 2, "A")
Next
End With

End Sub

SAS888
в том то и дело, что Бух не обязательно идёт за Упр и Не
структура примерно такая [more]Бухгалтерский учет.
Не списано по партиям 4 шт.
Бухгалтерский учет.
Не списано по партиям 2 шт.
Бухгалтерский учет.
Не списано по партиям 1 шт.
Бухгалтерский учет.
Не списано по партиям 1 шт.
Управленческий учет.
Не списано по партиям 1 шт.
Бухгалтерский учет.
Не списано по партиям 12 м
Бухгалтерский учет.
Не списано по партиям 30 м
Бухгалтерский учет.
Не списано по партиям 2 шт.
Проведение документа: Поступление доп. Расходов
Не найден в документе Поступление товаров и услуг
Поступление доп. Расходов
Бухгалтерский учет.
Не списано по партиям 20 шт.
Бухгалтерский учет.
Не списано по партиям 2 шт.
Управленческий учет.
Не списано по партиям 1 шт.[/more]

если другими словами перефразировать задачу
нужно удалить Бух и Не, а все остальное оставить в таком же порядке, скопировать на новый лист, пустые строки от Бух и Не - удалить, т.е. данные в столбце в ячейках должны идти друг за другом

Solenaja

Цитата:

нужно удалить Бух и Не, а все остальное оставить в таком же порядке, скопировать на новый лист, пустые строки от Бух и Не - удалить, т.е. данные в столбце в ячейках должны идти друг за другом

Копируем все данные из листа 1 в лист 2, затем удаляем ненужные строки.

Код: Sub Main()

Dim i As Long
Sheets(2).Activate
Cells.ClearContents: Sheets(1).Cells.Copy [A1]
For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Cells(i, "A") = "" Then Rows(i).Delete
If Left(Cells(i, "A"), 3) = "Бух" Then Rows(i).Delete
If Left(Cells(i, "A"), 2) = "Не" Then Rows(i).Delete
Next

End Sub

Вопрос:

Есть таблица из двух столбцов
Необходимо заполнить combobox значениями из второго столбца в зависимости от первого

for X=1 to 20
if range("A" & X)="заполнить" then comobox1.заполнить.значением.из. range("B" & X)
next X

Цитата:

Есть таблица из двух столбцов
Необходимо заполнить combobox значениями из второго столбца в зависимости от первого

for X=1 to 20
if range("A" & X)="заполнить" then comobox1.заполнить.значением.из. range("B" & X)
next X

Попробуй

for X=1 to 20
if Cells(X , 1)="заполнить" then ComboBox1.AddItem (Cells(X , 2))
next X

Здраствуйте.
Подскажите как можно определить, что пользователь выбрал текстовый файл?
Вот примерный код.

Sub Merging()

file1 = Application.GetOpenFilename("Text Files (*.txt), *.txt, Excel Files (*.xls), *.xls", 2)
'выбор файла

If file1 (*.txt) = True Then
'действие1
Else: 'действие2
End If

End Sub

Доброго времени!
подскажите что за такие ячейки в формуле

FormulaR1C1 = _
"=(RC[7]-RC[5])/RC[-2]"

RC[7]-RC[5] это я так понял номер столбца
а вот что такое RC[-2] как узнать на какую ячейку ссылка идет?

разобрался, RC[-2] это ячейка на два столбца влево от текущей ячейки..

2 AizecVHA
ну как самый простой вариант взять последних 3 символа с имени файла и сравнить их с нужным тебе расширением.

типа if right(file1.filename, 3) = "txt"
это для примера, синтаксис скорее всего неравильный, я Вб крайне редко юзаю..

Цитата:

ну как самый простой вариант взять последних 3 символа с имени файла и сравнить их с нужным тебе расширением.

типа if right(file1.filename, 3) = "txt"
это для примера, синтаксис скорее всего неравильный, я Вб крайне редко юзаю..

А вот меня конкретно синтаксис интересует, ибо идей у меня и так хватает.

AizecVHA

Попробуй
If Right(file1, 3) = "txt" Then

Mont1
Да работает, спасибо.

Привет всем!
Подскажите, а можно задать время на выполнение операции?
Например, хочу чтоб выделение ячеек происходило с интервалом 1 сек...
Если просто написать макрос, так он выделит диапазон в 1000 ячее и больше за сек...
СПС

MaximuS G тебе нужно воспользоваться функцией Timer

вот пример макроса, в котором ячейка окрашивается в красное на 0.3 сек, а потом цвет ячейки опять становится по умолчанию.

Код: Private Sub Worksheet_SelectionChange(ByVal Target As Range)
t = Timer
Selection.Interior.ColorIndex = 3
addr = Selection.Address
Do
DoEvents
Loop Until Timer - t >= 0.3
Range(addr).Interior.ColorIndex = xlNone
End Sub

Доброго времени суток всем присутствующим.
Кто-нибудь может помочь с такой проблемкой:
Есть две книги file1 и file2, каждая с двумя столбцами, первый из которых это идентификатор, второй - значения; вобщем надо значения из первой книги переместить во вторую (при совпадении ячеек из первого столбца). Я использовал следующий макрос, но работает он крайне медлено при большом количестве строк(понятно, при прямом переборе то). Вообщем, как можно более эффективно и быстрее это сделать?

Код: 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

AizecVHA
Цитата:

как можно более эффективно и быстрее это сделать?

1. отключить обновление экрана на момент сравнения (может быть еще поможет отключение автопересчета, хотя с др стороны формулы вроде не используются)

2. отвязаться от ячеек: то есть данные с обоих книг помещаем в массив, сравниваем - результат помещаем в третий массив и после всех вычислений результат сравнения выгружаем на лист.

При использовании обоих пунктов скорость должна увеличиться раз в 20-50. Такое уже вот на этой странице рассматривали. И еще в шапке о быстродействии написано.

народ помогите , а то моему мозгу будит капец
есть кселевский файл в нем есть столбец с номерами (id файлов) я создал в файл экселевский и там сделал 3 слобика
1 столбик это пусть до файла
2 столбик я копирую номера и 1 листа прямо столбиков все это ручками
3 столбик расширение файла тоесть в моем случае .avi
так вот мне хотябы накиньте макрос что бы он когда все это сделано объединял все строки во втором файле например в книгу 2 строк примерно 500
делаю функцией сцепить но она тока на одну строку

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

Код: Sub Skleyka()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Integer, t As String

t = Cells(11, 1).Value
For i = 12 To 180
t = t & Chr(10) & Cells(i, 1).Value
Next
Range("A1").Value = t

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

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

wait operator 0        
movie 0:00:07.00 [0.10] C:\рекламма\    219451    .avi
movie 0:01:12.59 [0.10] C:\рекламма\tv3.avi        
        
wait operator 0        
movie 0:00:07.00 [0.10] C:\рекламма\    219451    .avi
movie 0:00:07.00 [0.10] C:\рекламма\    700078576    .avi
movie 0:01:12.59 [0.10] C:\рекламма\tv3.avi        
        
wait operator 0        
movie 0:00:07.00 [0.10] C:\рекламма\    219451    .avi
movie 0:00:07.00 [0.10] C:\рекламма\    700078576    .avi
movie 0:00:07.00 [0.10] C:\рекламма\    700078718    .avi
movie 0:01:12.59 [0.10] C:\рекламма\tv3.avi        

q1wed
AizecVHA
Спасибо, большое! Приятно, когда есть у кого спросить

VARVARRRRR
непонятно тогда почему функцией сцепить не получается?
твоя формула (даже VBA не потребуется) будет примерно такой:
Если на Листе1 в столбца A, B и С тектс который необходимо склеить
то формула на Листе2 будет иметь следующий вид: =СЦЕПИТЬ(Лист1!A1;Лист1!B1;Лист1!C1) После вставки в одну из ячеек необходимо будет её "растянуть" вниз согласно количеству строк на первом листе.

С лишними пробелами придется повозиться (к тому же они какие то не стандартные пробелы), но тоже решаемо.

как раз что так сделать ээтой фукцией это можно я понял но вот как растянуть не очень понимаю, а делать по отдельности в каждую строку напряжна

Добавлено:
все понял пасиба
народ а подскажите ешо еси вас сильно не напрегет ето.
есть вот такое
Дом.ру         15 700068329
Цирк причуда клоуна        10    700072167
БЗ кабельное ТВ 2х2    1 бартер     30    219451

нада что бы он брал тока id ну последни цифры так сказать номера блоков у них отдельный столбец вставлял в другой лист и потом чтобы делал вот так




Добавлено:
все понял пасиба
народ а подскажите ешо еси вас сильно не напрегет ето.
есть вот такое
Дом.ру         15 700068329
Цирк причуда клоуна         10    700072167
БЗ кабельное ТВ 2х2    1 бартер     30    219451

нада что бы он брал тока id ну последни цифры так сказать номера блоков у них отдельный столбец вставлял в другой лист и потом чтобы делал вот так

wait operator 0        
movie 0:00:07.00 [0.10] C:\рекламма\    219451    .avi
movie 0:01:12.59 [0.10] C:\рекламма\tv3.avi        
        
wait operator 0        
movie 0:00:07.00 [0.10] C:\рекламма\    219451    .avi
movie 0:00:07.00 [0.10] C:\рекламма\    700078576    .avi
movie 0:01:12.59 [0.10] C:\рекламма\tv3.avi        

тоесть перед блоко так сказать ставил wait operator 0 после блока ставил movie 0:01:12.59 [0.10] C:\рекламма\tv3.avi а перед id ставил movie 0:00:07.00 [0.10] C:\рекламма\
тоесть что бы например все это было в столбце A ID в столбце B и надпись .AVi в столбце C
ну если конечно так проще

VARVARRRRR
Цитата:

нада что бы он брал тока id ну последни цифры

для частного случая подойдет =ПРАВСИМВ(A1;13) где 13 количество символов которые нужно отсчитать справа и вывести отдельно в ячейку. Затем дополнительно надо будет очистить получившуюся строку от лишних пробелов. Это подойдет в том случае если при взятии 13 знаков справа мы всегда будем "захватывать" весь ИД полностью и не "захватим" случайно текст слева.




для того чтобы прочитать мое сообщение полностью нажми на моем сообщении редактировать

плаваем не мелко тут все пучком просто прогроамма выгружает в экселе а мне нада делать плей лист под выдачу вот и думал замутить что попроще что бы не напрягать отдел програмирования при чем у нас ешо и филиал голова в другом городе...)))
ну все равно пасиб тебе за помощ даж не за помощ а вообще что откликнулись а то у меня уже вообще разочарование в форумах появилось...

Mont1
Спасибо!

ВОПРОС
Есть папка, в ней текстовые файлы.
Каким образом импортировать имена всех текстовых файлов и их содержимое?
Допустим надо получить два столбца A= имя файла B= содержимое файла.
Если можно то поподробнее..

я так думаю, что сначала надо как-то просканировать папку и создать список имен,
а уж потом извлеч из них содержимое

CEMEH

Цитата:

сначала надо как-то просканировать папку и создать список имен

http://vb.mvps.org/samples/project.asp?id=DirDrill
http://www.xtremevbtalk.com/archive/index.php/t-5050.html
http://www.codeproject.com/KB/vb/dirsinc.aspx
http://www.visualbasic.happycodings.com/Files_Directories_Drives/code55.html

http://www.google.com/search?hl=en&q=vb+dir+recursive