» Excel VBA (часть 3)

Ange30
Если одновременно то можно как то так:

If Cells(i, j) = Cells(i, b) AND Cells(i, j) = Cells(i, d) then
Cells(i, y) = 1
Else
Cells(i, y) = 0
End if

Добрый день.
Задача отобрать все строки в 4ом столбце все числа начинаются на 771 а затем перенести их на отдельный лист. Пробывал делать автофильтр руками (выбирал начинается на 771) не работает, пробывал в макросе забить следующий код:


Код:
Selection.AutoFilter Field:=4, Criteria1:="771*", Operator:=xlFilterValues

Добрый день!

Excel 2007 (rus)
Vista (rus)


Код:
Dim wba As Workbook
Set wba = ActiveWorkbook
lStr_Dir = wba.Path

Цитата:

Из-за кириллицы в пути к файлу отсылка не идёт.

Возможно нужно путь к файлу в DOS кодировку перевести. Для этого в начале модуля с Вашим кодом объявите функцию:

Код: Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long

Спасибо за ответ.
Я так и сделал потом. Всё хорошо, ftp.exe файл видит и отправляет, если батник из ДОСа запускать. Выяснилось, что cmd.exe не может запустить его из VBA, т.к. опять русские буквы, хоть и перекодированы.

Код:
strDirectoryListFtp = text866(wba.Path)
strDirectoryListFtpZZZ = strDirectoryListFtp & "\xlsftp"

.....................

AppFile = strDirectoryLisFtptZZZ & ".bat"
Shell "cmd.exe /c " & Chr(34) & AppFile & Chr(34)

Пробовал даже так:
Shell "cmd.exe /c cd " & Chr(34) & strDirectoryListFtp & "\" & Chr(34) & " && xlsftp.bat"

Sterh84
Для того, чтобы в автофильтре без ошибок применять критерий "начинается с...", необходимо, чтобы фильтруемые значения имели текстовый формат. Вашу задачу можно решить, применив либо регулярные выражения, либо проверкой каждого значения. Но, и в том и другом случае понадобится организовывать цикл по столбцу (значениям столбца в массиве).
Предлагаю альтернативное решение, без каких-либо циклов. В следующем примере предполагается, что данные находятся в диапазоне "A1:F100", где в 1-й строке - заголовки. Отфильтрованные строки, значения в столбце "D" которых начинаются на "771*", будут скопированы во 2-й лист, начиная со следующей, после последней заполненной строки в столбце "A". Макрос следует запускать при активном листе с данными и отключенным автофильтром.

Код: Sub qq()
Dim a(): Application.ScreenUpdating = False
a = [D2:D100].Value: [D2:D100] = ["'" & D2:D100]
[A:F].AutoFilter Field:=4, Criteria1:="=771*"
ActiveSheet.AutoFilter.Range.Offset(1).Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
Sheets(2).UsedRange.Value = Sheets(2).UsedRange.Value
[A:F].AutoFilter: [D2:D100].Value = a
End Sub

Помогите мне, пожалуйста, есть бланк, где надо посчитать общее
(прикрепляю его)
Как сделать, чтобы эта анкетка стала шаблоной. Например, один респондент прошел, обвел желтым ту циферку с которой согласен, далее получил свой средний бал.
Потом подошел бы другой респондент, убрал бы выделение и стал уже выделять те циферки, которые считает нужным.
Просто эта анкета разделена по сферам. Среднее надо посчитать по каждой сфере.
Просто ,когда много испытуемых самому это делать просто не реал.
http://rusfolder.com/35294104

Привет, кто может подсказать с написанием макроса и возможно ли такое? Вообщем ситуация такова, в столбце "А" есть определённые значения, допустим 1,2,3,4 и т.д. в столбец "В" нужно импортировать данные а,б,в,г и т.д. со смещением строк. То есть в ячейке А1 значение 1, импортирую данные из текстового редактора в столбец "В" их n-строк (например 5 строк), получается в столбце "А" строки должны сместиться на n-строк (на эти 5 строк) и цифра 2, которая была в ячейке "А2" сместится в ячейку "А7". Нашел макрос на импорт из текстового файла, а со смещением строк разобраться не могу

Код: Application.Goto Reference:="Макрос1"
Range("J12").Select
Dim TextLine
i = 1
Open "C:\Macros\#1.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, TextLine
ThisWorkbook.Worksheets("Лист1").Cells(i, 1).Value = TextLine
i = i + 1
Loop
Close #1
End Sub

Sterh84

Цитата:

Задача отобрать все строки в 4ом столбце все числа начинаются на 771 а затем перенести их на отдельный лист.

Зачем автофильтр-то мучать. Он совсем простой, для сложных вещей есть расширенный фильтр в том же меню. Пишешь условие отбора

Код: =ЛЕВСИМВ(D2;3)="771"

panda3, да всё правильно, но почему-то не опускает на количество ячеек импортируемое из файла, а ставит напротив наименований в столбце А

alek1986
Записывайте данные не сразу на лист, а в массив, верхняя граница которого скажет на сколько нужно сместить, потом воспользуйтесь советом panda3.

Здравствуйте. Помогите в написании простого макроса.
Есть много однотипных отчётов по дням. Нужно копировать полностью каждый отчёт , за исключением шапки (первой строки) и вставлять в текущую таблицу (в новом открытом листе, можно заранее создать файл с именем "otchet_2013").
Проблема (для меня) в том, что:
- кол-во строк копируемого отчёта заранее не известен (кол-во столбцов точное до "W");
- надо вставлять в первую пустую строку , т.е. в конец таблицы.
Помогите кто может.

Привет!
Задача состоит в следующем: есть разрисованная таблица на Листе1, есть таблица данных на Листе2, нужно что бы в зависимости от условия в таблице данных (Лист2) макрос окрашивал цветом, в зависимости от условия, на другом листе определенные ячейки.
УФ - не подходит, из-за нехватки привязки к другим ячейкам.
Кто сталкивался?

vitrzn
Отчеты в разных книгах или разных листах?
Поиск последней заполненной строки в колонке А:
lr = Cells(Rows.Count, "A").End(xlUp).Row

Peen
Отлавливаете изменение ячеек:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Worksheets(1).Range("A1:A10"), Target) Is Nothing Then
Worksheets(2).Cells(1, 1).Interior.ColorIndex = 5
End If
End Sub

vitrzn
Следующий макрос скопирует все значения листа sh1, начиная со второй строки из столбцов "A:W" в лист sh2, под имеющуюся таблицу. Причем, какой из столбцов таблицы листа sh2 длиннее - не имеет значения.

Код: Sub qq()
Dim sh1 As Worksheet, sh2 As Worksheet
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Set sh1 = Sheets(1): Set sh2 = Sheets(2)
Intersect(sh1.UsedRange, sh1.Rows("2:" & Rows.Count), sh1.[A:W]).Copy _
sh2.Cells(sh2.Cells.Find("*", sh2.[A1], , , xlByRows, xlPrevious).Row + 1, 1)
End Sub

SAS888
Спасибо!

Хотел спросить, но уже понял - а сообщение удалить нельзя...

Народ помогите! Такая проблема при установке лицензионного MS Office2010 как сделать привязку к файлам excel?
C:\Program Files\Microsoft Office\Office14 там есть EXCEL (собственно к нему и надо сделать привязку), excelcnv и в самом низу XLICONS. Когда выбираешь EXCEL ничего не происходит и в списке выбоа программ excel не появляется.
Права администратора на машине. В какую сторону копать? Переустановка результатов не дала...

setwolk
Excel.exe по идее искать нужно.

Добавлено:
Может попробовать запустить Excel и открыть файл из него? Перед установкой у Вас какая версия стояла?

andrewkard1980
Все уже решил вопрос, путем вычищения раздела HKEY_CLASSES_ROOT все что связано с excel

можно ли удалить/обойти/подобрать пароль, установленный не на листе, а внутри самого макроса? в excel'e редактирование оного макроса недоступно.

BeTheRED
Что значит внутри макроса? В тексте кода или VBA Project - Protection - Lock project for viewing?

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

BeTheRED
Проект запоролен от просмотра - нужно вспоминать пароль тогда.

andrewkard1980
слишком очевидный вариант

каким-либо образом влезть в кишки и вырвать заразу?

BeTheRED
выложите файл, посмотрим

оригинал:

https://dl.dropbox.com/u/41311998/%D0%9F%D0%BE%D0%B4%D0%B1%D0%BE%D1%80%20%D0%B3%D1%80%D0%BE%D0%BC%D0%BA%D0%BE%D0%B3%D0%BE%D0%B2%D0%BE%D1%80%D0%B8%D1%82%D0%B5%D0%BB%D0%B5%D0%B9%20%D0%B8%20%D1%83%D1%81%D0%B8%D0%BB%D0%B8%D1%82%D0%B5%D0%BB%D0%B5%D0%B9.xls


со снятой защитой листа:

https://dl.dropbox.com/u/41311998/%D0%9F%D0%BE%D0%B4%D0%B1%D0%BE%D1%80%20%D0%B3%D1%80%D0%BE%D0%BC%D0%BA%D0%BE%D0%B3%D0%BE%D0%B2%D0%BE%D1%80%D0%B8%D1%82%D0%B5%D0%BB%D0%B5%D0%B9%20zashita%20snyata.xlsm

BeTheRED
попробуйте ЕGlavryba1 для оригинала

Vitus_Bering

не подходит

абырвалг :\

BeTheRED
Попробуйте тут: http://rghost.ru/44871858