» Excel VBA (часть 2)

Igory26
Выражение абсолютно правильное. Проблема в данных которые Вы подсовываете на листах книг 1 и 2.
У меня это выражение прекрасно работает.

/интересная перессылка получилась /

Помогите, пожалуйста, токая проблема, с помощью макроса создаю текстовый файл, при запуске макроса появляется сообщение: код ошибки 53 (Файл не найден). Пробовал запускать на других компах макрос работает нормально, а на моем не хочет.

Текст Макроса:
Sub main()
Dim DataRow As Range, n As Integer, total As Double
Set DataRng = Range("DataRange")
Filename = ThisWorkbook.Path & "\Payment.txt"
Open Filename For Output As #1
Print #1, "START;" & Format(Date, "ddmmyyyy") & ";1;CREDIT;" & Range("OrgName").Value
n = 0
total = 0
For Each DataRow In DataRng.Rows
If IsEmpty(DataRow.Cells(1, 1).Value) Then Exit For
If DataRow.Cells(1, 2).Value > 0 Then
n = n + 1
total = total + DataRow.Cells(1, 2).Value
s = Format(DataRow.Cells(1, 2).Value, "#0.00")
' s = Replace(s, ".", ",")
s = Left(s, Len(s) - 3) & "," & Right(s, 2)
Print #1, DataRow.Cells(1, 1).Value & ";" & s
End If
Next
s = Format(total, "#0.00")
' s = Replace(s, ".", ",")
s = Left(s, Len(s) - 3) & "," & Right(s, 2)
Print #1, "END;" & n & ";" & s & ";RUR"
Close #1
Call FillReestr
End Sub

SamoylovA
Может здесь ошибка (?):

Цитата:

ThisWorkbook.Path

- ссылается на каталог где лежит книга с этим макросом
Если в этом каталоге нету Payment.txt то будет ошибка

Igory26

Цитата:

Нужно из одной книги записать данные в другую

А зачем вы используете FormulaR1C1, а не просто Value?

visual73


Цитата:

- ссылается на каталог где лежит книга с этим макросом
Если в этом каталоге нету Payment.txt то будет ошибка

Такой вариан прорабатывал, безрезультатно.


Строка: Filename = ThisWorkbook.Path & "\Payment.txt" , присваевает значение переменной состоящей из адреса (где лежит книга) плуюс имя файла. Т.е. значение переменной Filename к примеру будет "с:\Payment.txt".

В строке: Open Filename For Output As #1 , открытия текста Output-режим последовательного доступа, который позволяет выполнять чтение и запись файла. В этом режиме всегда создается новый файл (существуйщийс текущим именем удаляется).

Ошибку выдает на второй из перечисленых строк.

SamoylovA
Проверить, не открыт ли файл (на запись или просто с блокировкой) какой-либо другой программой (в т.ч. и самим Excel или VBA).

Знатоки! Помогите чайнику! Необходимо к блоку ячеек с текстом добавить отступы по высоте от рамки ячейки до текста до и после текста в каждую ячейку. Или по иному решить следующую проблему: программа выводит результаты своей работы в книгу excel при этом последняя строка текста в ячейке не печатается. Ручками раздвигать муторно, автоподбор высоты строки результатов не дает. Одна надежа на вашу помощь!

Вопрос: делаю прогу сравнения двух екселевских файлов. Листинг ниже. Почему, как толкьо пытаюсь сделать close или Save для Report.xls вылетает ошибка Out of Range. Вроде все пишу, как в хелпе.

With Worksheets(1)
Set objHyper = _
.Hyperlinks.Add(Anchor:=.Range("A10"), _
Address:="c:\Report.xls")
objHyper.CreateNewDocument _
Filename:="c:\Report.xls", _
EditNow:=False, Overwrite:=True

End With
Workbooks.Open Filename:=Label2.Caption
Workbooks.Open Filename:=Label1.Caption
Dim a(10) As String
Dim i As Integer

For i = 1 To 7
a(i) = Sheets("Лист1").Cells(1, i)
Next i

Workbooks.Open Filename:="c:\report.xls"

For i = 1 To 7
Sheets("Лист1").Cells(1, i) = a(i)


Next i

Workbooks.Open Filename:=Label1.Caption
Dim j As Integer
j = 1

Do While Sheets("Лист1").Cells(j, 1) <> ""
j = j + 1
Loop

Dim ind As Integer


For ind = 2 To (j - 1)

Workbooks.Open Filename:=Label1.Caption
For i = 1 To 7
a(i) = Sheets("Лист1").Cells(ind, i)
Next i

Workbooks.Open Filename:=Label2.Caption
Dim sear As Integer
sear = 2
Do While Sheets("Лист1").Cells(sear, 2) <> a(2)
sear = sear + 1
Loop
a(5) = Str(Val(a(5)) - Val(Sheets("Лист1").Cells(sear, 5)))
a(7) = Str(Val(a(5)) * Val(a(6)))

Workbooks("c:\report.xls").Close
Workbooks.Open Filename:="c:\report.xls"
For i = 1 To 7
Sheets("Лист1").Cells(ind, i) = a(i)
Next i

Next ind

war2005

Цитата:

Workbooks("c:\report.xls").Close

надо закрывать так: Workbooks("report.xls").Close Всё равно Excel не даст вам открыть 2 файла с одинаковыми именами, даже если они в разных директориях.
А вообще - старайтесь работать с указателями на объекты, например, Add и Open возвращают указатели на вновь созданную или открытую книгу:
Код: Dim wb As Workbook

Set wb = Workbooks.Add
wb.Sheets(1).Cells(1, 1).Value = "*"
wb.Close (False) ' False - не сохранять изменения
Set wb = Nothing ' Удаляем указатель после использования (на всякий случай)

здрасти!
помогите, пожалуйста а то у меня не получается.....
у меня есть код который переносит мне данные из двух столбцов файла который открыт на данный момент, а мне нужно чтобы при нажатии кнопки открывалось окно windows и я могла выбрать любой файл excel и чтоб два столбика из этого файла появились в userform в Spreadsheet.....

это код, который переносит данные с открытого на данный момент файла:
Private Sub CommandButton2_Click()
Dim i
For i = 1 To 200
UserForm1.Spreadsheet1.Range("B" & i).Value = Range("B" & i).Value
Next
Dim j
For j = 1 To 200
UserForm1.Spreadsheet1.Range("C" & j).Value = Range("C" & j).Value
Next
End Sub

это код, который открывает окно windows:

Private Sub CommandButton1_Click()
Dim FilterIndex As Integer
Dim FileName As Variant
Dim Title As String
Title = "Choose import file"
FileName = Application.GetOpenFilename(Title:=Title)
If FileName = False Then
MsgBox "File don't choose!"
Exit Sub
End If
MsgBox "You choose " & FileName
End Sub

как их объединить?
заранее спасибо!

NaThAlieK
1) копируете первый код, всё кроме Private Sub и End Sub, вставляете в конец после Msgbox

2) Между двумя кусками надо вставить код, который открывает файл, поскольку тот код, который у вас теперь идёт первым просто получает имя файла в переменную FileName (хотя можно немного поменять код, чтобы после диалога файл сам открывался).

3) Далее, чтобы вам считать данные из только что открытого файла вам надо в строчках дописать перед подчёркнутым Range либо указатель на файл (его легче всего получить при открытии), либо обратиться через имя открытого файла (только имя, путь и диск лучше не указывать, пример приведён ниже):
UserForm1.Spreadsheet1.Range("B" & i).Value = Range("B" & i).Value
UserForm1.Spreadsheet1.Range("C" & j).Value = Range("C" & j).Value

Должно получиться что-то вроде:

Код:
UserForm1.Spreadsheet1.Range("B" & i).Value = Workbooks(filename2).sheets(1).Range("B" & i).Value

спасибо за помощь!
только как этот код написать,который открывает файл? у меня нет опыта с VBA - я только учусь ...sorry

Здравствуйте! Кто поможет справиться с проблемой? На 2007 офисе не срабатывает макрос старой версии(сумма прописью, язык латышский). Пример
http://rapidshare.com/files/115650577/Primer.rar

Добрый день спецы! Как всегда нужна помощь, вопрос не сложный, но т.к. я не знаком с VBA прошу помощи

Есть обычный столбец ввида:
d14565
345987
f14578
и т.п.

Необходимо начиная с первой ячейки вставлять в ниже код в строку "ВОТ СЮДА", затем вторую ячейку, но сохраняя код и в ней первую ячейку и т.д., тоесть получится столбец с повторяющим кодом, только разные там будут шестизначное набор цифр и букв.

ВОт этот код:

wait 10 sec until FieldAttribute 0008 at (4,22)
wait 10 sec until cursor at (4,23)
[wait app]
"f75612-ВОТ СЮДА!!!!
[enter]
[wait inp inh]
wait 10 sec until FieldAttribute 0000 at (4,14)
wait 10 sec until cursor at (4,17)
[wait app]
[roll up]
[roll up]
[pf12]

Данный результат куда-то сохранить, не критично куда, хоть просто в текстовик, вот типа что должно получится:

Цитата:

wait 10 sec until FieldAttribute 0008 at (4,22)
wait 10 sec until cursor at (4,23)
[wait app]
"d14565
[enter]
[wait inp inh]
wait 10 sec until FieldAttribute 0000 at (4,14)
wait 10 sec until cursor at (4,17)
[wait app]
[roll up]
[roll up]
[pf12]
wait 10 sec until FieldAttribute 0008 at (4,22)
wait 10 sec until cursor at (4,23)
[wait app]
"345987
[enter]
[wait inp inh]
wait 10 sec until FieldAttribute 0000 at (4,14)
wait 10 sec until cursor at (4,17)
[wait app]
[roll up]
[roll up]
[pf12]

и т.п.

NaThAlieK

Цитата:

только как этот код написать,который открывает файл? у меня нет опыта с VBA - я только учусь

В моей версии Excel нет такой штуки, как Spreadsheet, так что проверить код не могу, проверяйте его сами: [more=далее...]

Код:
Sub ttt()


Dim FilterIndex As Integer
Dim FileName As Variant
Dim Title As String
Title = "Choose import file"
FileName = Application.GetOpenFilename(Title:=Title)
If FileName = False Then
MsgBox "File don't choose!"
Exit Sub
End If
MsgBox "You choose " & FileName

Dim wb As Workbook, ws As Worksheet
Set wb = Workbooks.Open(FileName, , True)
Set ws = wb.Sheets("Лист1")

Dim i
For i = 1 To 200
' Я бы тут вместо Range использовал бы Cells(i,"B"), поскольку операция
' производится с одной ячейкой, а не несколькими. Это должно быстрее
' работать, чем в вашем случае (лишняя операция - сложение строк).
UserForm1.Spreadsheet1.Range("B" & i).Value = ws.Range("B" & i).Value
Next
Dim j
For j = 1 To 200
' Здесь тоже Cells, как сказано выше
UserForm1.Spreadsheet1.Range("C" & j).Value = ws.Range("C" & j).Value
Next

' Закрываем всё
Set ws = Nothing: wb.Close False: Set wb = Nothing

End Sub

Всем доброго времени суток. Помогите.. а то уже замаялся..третий днь бьюсь не могу понять Есть 2 колонки, одна с комбинацией букв, во второй прописанны 2 значения.
Необходимо найти требуемые комбинации, тоесть в 1-й колонке qw qwe ree uty fkh eek и т.д. Мне надо найти ячейки в которых есть комбинация "ее". Затем, если во второй колонке этой же строки, где есть "ее", первое значение, то 1-й счетчик +1, если второе знчение, то 2-й счетчик +1.

myArray = Array("*ее*")
Status = "1-езначение"
FinalRow = Cells(1000, RabCollum).End(xlUp).Row
For i = 2 To FinalRow
Set c = Cells(i, 1).Find(What:=myArray)
If Not c Is Nothing Then
If Cells(i, 2) = Status Then
a = a + 1
Else
b = b + 1
End If
End If
Next i

Вроде бы все просто.. но Find(What:=myArray) находит у меня "ее" при любых значениях Cells(i, 1).. Тоесть, в перечне qw qwe ree uty fkh eek, когда в ячейке Cells(1, 1) находится "qw", с="ree"...

Помогите плиз... Не понимаю, почему Find(What:=myArray) ищет по всему диапазону (и где этот диапазон задан), а не по Cells(i, 1)...

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

nick7inc
заработало!!!
спасибо огромное!!!
только с Cells не хотел работать, а с Range согласился.
Spreadsheet я добавила с Toolbox его полное имя - Microsoft Office Spreadsheet

0legka
Вот пример использования метода Find (FindNext), применительно к Вашей задаче для всего столбца RabCollum

Код: Sub CountStatus()

Dim x As Range, a As Long, b As Long, Fst As String, Status As String, RabCollum As Integer

Status = "1-е значение"
RabCollum = 1 ' Пусть для столбца "A"
a = 0: b = 0

Set x = ActiveSheet.Columns(RabCollum).Find(what:="ee", LookAt:=xlPart) ' xlPart - искать частичное совпадение
If Not x Is Nothing Then
Fst = x.Address
Do
If x.Offset(, 1) = Status Then a = a + 1 Else b = b + 1
Set x = ActiveSheet.Columns("A").FindNext(x)
Loop While Fst <> x.Address
End If

MsgBox a & " " & b

End Sub

NaThAlieK

Цитата:

Spreadsheet я добавила с Toolbox его полное имя - Microsoft Office Spreadsheet

Век живи, век учись... Нашёл, интересная штука.

2 SAS888

Спасибо! Все работает...

Подскажите пожалуйста по Excel 2003. На листе размещены 7 таблиц с одинаковым количеством столбцов. Между таблицами (для удобства) разделительные пустые столбцы. Количество строк в столбцах разное и будет меняться в зависимости от ежемесячного обновления (копирование из отчетной таблицы диагностической программы в данную форму Excel).
В первой строке (объединенная ячейка, содержащая все столбцы конкретной из 7 таблиц) каждой таблицы ее название.
Требуется переставить ( не транспонировать) 7 таблиц по вертикали: сначала- все строки 1 таблицы, под ней- все строки 2 и т.д.до 7 включительно. Ширина таблицы с количеством строк равным сумме строк 7 таблиц и с одинаковым количеством столбцов(по ширине).
Проблема в разном количестве строк в каждой таблице. Конечно, желательно использование стандартной функции извлечения номера столбца в первой строке при нахождении названия каждой из таблиц.
В Excel нет прямой формулы извлечения адреса ячейки, содержимое которой совпадает с данной.
Самое простое решение для извлечения адреса ячейки с содержимым сделать добавление в макрос функции ВПР и ГПР ( возможно ненужную часть вообще удалить) . Ведь она как то идентифицирует данные с содержимым ячейки, и только потом ссылается на содержимое ячейки в том же столбце.

Помоги те пожалуйста я написал макрос для печати выделенного фрагмента а можно ли еще и сохранить его как нибудь на диск скажем в формате .txt или что нить в духе
Private Sub CommandButton1_Click()

Range("A1:J34").Select
Range("J34").Activate
Selection.PrintOut Copies:=1, Collate:=True

End Sub

Большое спасибо заранее очень нужно

основа взята здесь ... http://forum.ru-board.com/topic.cgi?forum=33&topic=8273&start=1800

Sub Notepad()
Dim cel As Range

Dim ReturnValue
ReturnValue = Shell("NOTEPAD.EXE", 1) ' Запускаем блокнот
AppActivate ReturnValue ' Активизируем блокнот

For Each cel In Selection
cel.Copy
SendKeys "^V", True 'Вставляем данные из буфера обмена
Next

End Sub

привет

имеется таблица с данными. под ячейкой с графой Фамилии идет список состоящий из фио.

разделил вручную на 3 графы
Фамилия Имя Отчество

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

doc58_81oB0t

Цитата:

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

если я правильно понял, то выделите столбец с фио и попробуйте
главное меню "Данные" - "Текст по столбцам" - разделитель "Пробел"

подскажите что бы не изобретать велосипед - есть где либо пример макроса создания Предметного указателя из вордовского текста причем список фраз уже создан

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

SERGE_BLIZNUK спасиб, то что надо

а вот еще такой вопрос всплыл:
произвел разделение по аналогии с категориями: дом корпус квартира

дом корпус квартира
д.01 КОР.11 КВ.60
д.11 кв.4

у кого в адресе нет корпуса вписывается квартира в графу корпус. можно это тоже как-то автоматом отслеживать? т.е. допустим есть ли макрос который бы следил за тем чтоб в графе квартира было все что начинается с 'кв.' и тд?

doc58_81oB0t
Цитата:

есть ли макрос который бы следил за тем чтоб в графе квартира было все что начинается с 'кв.' и тд?

так в чём проблема? напишите... тут ничего сложного. Если реально хотите, чтобы всё время следил - вешайте на Worksheet_Change
но лично я, особого смысла в постоянной проверке не вижу.
лично я бы сделал макрос, который нужно было бы запускать ручками (ну или повесил его на кнопку) - вставил адреса, разбросал. потом выполнил корректирующий макрос.
условие работы такое:
если в столбце "корпус" значение начинается с 'кв' и столбец справа ("квартира") пуст - тогда перенести значение из столбца "Корпус" -> "Квартира"

Помогите решить следующую задачу:
имеется клетка с колличеством "чего либо" если по ней щелкнуть правой кнопкой мыши то добавляется единица к "чему либо", а если левой то отнимается единица "чего либо"

как это реализовать?

табличка не очень большая в принципе можно организовать на кнопках.
только количество должно отображаться на кнопке и также правым/левым нажатием мыши изменялось