Есть 3 комбобокса, расположенные на листе. Диапазон их значений (ListFillRange) A1:A5. Как сделать так, чтобы при выборе определенного значения в комбобоксе, в других комбобоксах этого значения в списке не было?
» Excel VBA (часть 2)
У меня 2 вопроса:
1)Возможно ли по нажатию кнопки на userform прокручивать лист на одну позицию вниз.
2)Есть ли тип переменых для точного вычисления с пятым знаком после запятой
1)Возможно ли по нажатию кнопки на userform прокручивать лист на одну позицию вниз.
2)Есть ли тип переменых для точного вычисления с пятым знаком после запятой
WowGun
Дело в том, что
Ëèñò1 - это и есть Лист1;
Ëèñò2 - это Лист2
Просто после ввода в форму и отправки данных руссие буквы перекодировались и миру стала видна абракадабра.
Что делает вышеизложенный скрипт - он формирует новую книгу, переименовывает 1-й и 2-й
лист в нужные мне названия, а остальные листы удаляет. Так я и задумал.
Но вопрос в другом - мне нужно скопировать диапазон, который я выделил в старой книге, в новую книгу. Это у меня не получается.
Подскажите, плз.
ЗЫ: что именно не получается: у меня формируется новая книга, но диапазон из старой книги в нее не копируется, листы книги остаются пустыми.
ЗЫ2:
> 7-я ... ЕСЛИ Вы листы с ТАКИМИ именами НЕ найдете ( а их там НЕТУ!!!) то Вы удалите ВСЕ листы ...
Да нет, я удалю только те листы, которые не подпадают под условие выше. Это можно понять, исходя из логики конструкции.
Добавлено:
cio_new
Все, спасибо, реализовал так:
With Worksheets(sTab).Range("a1:ea2")
Set c = .Find("Import File Generation. PLEASE DO NOT EDIT.", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address()
End If
End With
With Worksheets(sTab).Range("a5:ea200")
Set cc = .Find("n", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
If Not cc Is Nothing Then
lastAddress = cc.Address()
Do
Set cc = .FindNext(cc)
Loop While Not cc Is Nothing And cc.Address <> lastAddress
End If
End With
Worksheets(sTab).Range(firstAddress, lastAddress).Copy
Dim oWbk As Workbook
Dim oWorksheet As Worksheet
Application.DisplayAlerts = False
Set oWbk = Application.Workbooks.Add()
For Each oWorksheet In oWbk.Worksheets
If oWorksheet.Name = "Лист1" Then
oWorksheet.Name = sTab
oWorksheet.Range("a1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Else
oWorksheet.Delete
End If
Next
oWbk.SaveAs Filename:= _
sPathcsv & "\" & sTab & " v1.0.csv", _
FileFormat:=xlCSV, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
oWbk.Close (True)
Sheets(sTab).Select
Sheets(sTab).Copy
ActiveWorkbook.SaveAs Filename:= _
sPath & "\" & sTab & " v1.0.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close (True)
Дело в том, что
Ëèñò1 - это и есть Лист1;
Ëèñò2 - это Лист2
Просто после ввода в форму и отправки данных руссие буквы перекодировались и миру стала видна абракадабра.
Что делает вышеизложенный скрипт - он формирует новую книгу, переименовывает 1-й и 2-й
лист в нужные мне названия, а остальные листы удаляет. Так я и задумал.
Но вопрос в другом - мне нужно скопировать диапазон, который я выделил в старой книге, в новую книгу. Это у меня не получается.
Подскажите, плз.
ЗЫ: что именно не получается: у меня формируется новая книга, но диапазон из старой книги в нее не копируется, листы книги остаются пустыми.
ЗЫ2:
> 7-я ... ЕСЛИ Вы листы с ТАКИМИ именами НЕ найдете ( а их там НЕТУ!!!) то Вы удалите ВСЕ листы ...
Да нет, я удалю только те листы, которые не подпадают под условие выше. Это можно понять, исходя из логики конструкции.
Добавлено:
cio_new
Все, спасибо, реализовал так:
With Worksheets(sTab).Range("a1:ea2")
Set c = .Find("Import File Generation. PLEASE DO NOT EDIT.", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address()
End If
End With
With Worksheets(sTab).Range("a5:ea200")
Set cc = .Find("n", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
If Not cc Is Nothing Then
lastAddress = cc.Address()
Do
Set cc = .FindNext(cc)
Loop While Not cc Is Nothing And cc.Address <> lastAddress
End If
End With
Worksheets(sTab).Range(firstAddress, lastAddress).Copy
Dim oWbk As Workbook
Dim oWorksheet As Worksheet
Application.DisplayAlerts = False
Set oWbk = Application.Workbooks.Add()
For Each oWorksheet In oWbk.Worksheets
If oWorksheet.Name = "Лист1" Then
oWorksheet.Name = sTab
oWorksheet.Range("a1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Else
oWorksheet.Delete
End If
Next
oWbk.SaveAs Filename:= _
sPathcsv & "\" & sTab & " v1.0.csv", _
FileFormat:=xlCSV, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
oWbk.Close (True)
Sheets(sTab).Select
Sheets(sTab).Copy
ActiveWorkbook.SaveAs Filename:= _
sPath & "\" & sTab & " v1.0.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close (True)
Fierce1
Благодарствую!
Ускорить процесс как-нибудь можно?
на двухядер-м проце с 3 г озу где-то 1 минута 15 сек обрабатывал 35000 строк
Благодарствую!
Ускорить процесс как-нибудь можно?
на двухядер-м проце с 3 г озу где-то 1 минута 15 сек обрабатывал 35000 строк
mistx
Ну если 35000 строк все разные, то ускориться врятли получиться. А если есть повторяющиеся строки, то впринцыпе можно. Только чтоб бы эффект, повторяющихся строк должно быть много
Ну если 35000 строк все разные, то ускориться врятли получиться. А если есть повторяющиеся строки, то впринцыпе можно. Только чтоб бы эффект, повторяющихся строк должно быть много
Привет, помоготе пожалуйста!
Если используется первый ResSQL то данные достаю(на фирме аутентификация Windows)
А если второе подключение (в данный момент закоментировано)
1. с доменном "firma\" выдает ошибку -
run-time error '-2147217543 (80040e4d)':
Недоступное имя учетной записи или пароль.
2. без домена выдает ошибку -
run-time error '-2147217843 (80040e4d)':
Не удаеться запустить приложение. Системная база данных отсутствует или открыта с монопольным доступом другим пользователем.
Файл находиться в розшариной папке на сервере SP.
Посмотрите пож. может синтаксис не правельный или я что-то не так делаю?
Спасибо.
Код:
Sub Проект()
Dim Рес, ResSQL, ПроектыВехи, f
Dim rs As New ADODB.Recordset
ResSQL = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\projectsrv\sites\MS_ProjectServer_PublicDocuments\Shared Documents\01.XLS" _
& ";Extended Properties=Excel 8.0" 'Подключение есть
'ResSQL = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\projectsrv\sites\MS_ProjectServer_PublicDocuments\Shared Documents\01.XLS" _
& ";User ID=firma\Alexandr;Password=pas;Extended Properties=Excel 8.0" 'Нет подключения
Рес = "SELECT * FROM [RESERVED_DATA1$]"
rs.Open Рес, ResSQL, adOpenStatic
While (Not rs.EOF)
ПроектыВехи = rs.GetString(adClipString)
Wend
rs.Close
End Sub
Если используется первый ResSQL то данные достаю(на фирме аутентификация Windows)
А если второе подключение (в данный момент закоментировано)
1. с доменном "firma\" выдает ошибку -
run-time error '-2147217543 (80040e4d)':
Недоступное имя учетной записи или пароль.
2. без домена выдает ошибку -
run-time error '-2147217843 (80040e4d)':
Не удаеться запустить приложение. Системная база данных отсутствует или открыта с монопольным доступом другим пользователем.
Файл находиться в розшариной папке на сервере SP.
Посмотрите пож. может синтаксис не правельный или я что-то не так делаю?
Спасибо.
Код:
Sub Проект()
Dim Рес, ResSQL, ПроектыВехи, f
Dim rs As New ADODB.Recordset
ResSQL = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\projectsrv\sites\MS_ProjectServer_PublicDocuments\Shared Documents\01.XLS" _
& ";Extended Properties=Excel 8.0" 'Подключение есть
'ResSQL = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\projectsrv\sites\MS_ProjectServer_PublicDocuments\Shared Documents\01.XLS" _
& ";User ID=firma\Alexandr;Password=pas;Extended Properties=Excel 8.0" 'Нет подключения
Рес = "SELECT * FROM [RESERVED_DATA1$]"
rs.Open Рес, ResSQL, adOpenStatic
While (Not rs.EOF)
ПроектыВехи = rs.GetString(adClipString)
Wend
rs.Close
End Sub
mistx
Цитата:
Можно. Попробуйте следующий код:
Код: Dim i As Integer, j As Integer, a(), b(), c()
With Sheets("название листа")
a = Range([A1], Cells(Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value
b = .Range(.[A1], .Cells(.Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value
End With
ReDim c(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
For j = 1 To UBound(b, 1)
If a(i, 1) = b(j, 1) Then c(i, 1) = b(j, 2)
Next
Next
Range([B1], Cells(UBound(c, 1), "B")).Value = c
Цитата:
Ускорить процесс как-нибудь можно?
Можно. Попробуйте следующий код:
Код: Dim i As Integer, j As Integer, a(), b(), c()
With Sheets("название листа")
a = Range([A1], Cells(Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value
b = .Range(.[A1], .Cells(.Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value
End With
ReDim c(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
For j = 1 To UBound(b, 1)
If a(i, 1) = b(j, 1) Then c(i, 1) = b(j, 2)
Next
Next
Range([B1], Cells(UBound(c, 1), "B")).Value = c
SAS888
а как здесь можно сослаться на листы?
With Sheets("название листа")
(здесь о каком листе идет речь?)
у меня на первом листе "Источник" в первом столбце с 2 по 35000 строк импортируются данные.
а на листе "шаблон" с первой строки по 129 находятся организации, во 2 столбце - значения, заранее вписанные.
необходимо значения исходя из шаблона вписать в 17 столбец листа "Источник" со второй строки.
Заранее благодарен.
а как здесь можно сослаться на листы?
With Sheets("название листа")
(здесь о каком листе идет речь?)
у меня на первом листе "Источник" в первом столбце с 2 по 35000 строк импортируются данные.
а на листе "шаблон" с первой строки по 129 находятся организации, во 2 столбце - значения, заранее вписанные.
необходимо значения исходя из шаблона вписать в 17 столбец листа "Источник" со второй строки.
Заранее благодарен.
mistx
Конкретно под Ваши требования так:
Код: Dim i As Integer, j As Integer, a(), b(), c()
Sheets("Источник").Activate
With Sheets("шаблон")
a = Range([A1], Cells(Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value
b = .Range(.[A1], .Cells(.Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value
End With
ReDim c(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
For j = 1 To UBound(b, 1)
If a(i, 1) = b(j, 1) Then c(i, 1) = b(j, 2)
Next
Next
Range(Cells(1, 17), Cells(UBound(c, 1), 17)).Value = c
Конкретно под Ваши требования так:
Код: Dim i As Integer, j As Integer, a(), b(), c()
Sheets("Источник").Activate
With Sheets("шаблон")
a = Range([A1], Cells(Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value
b = .Range(.[A1], .Cells(.Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value
End With
ReDim c(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
For j = 1 To UBound(b, 1)
If a(i, 1) = b(j, 1) Then c(i, 1) = b(j, 2)
Next
Next
Range(Cells(1, 17), Cells(UBound(c, 1), 17)).Value = c
SAS888
Обалдеть! Огромное спасибо!
разобраться бы еще в этом.
Здесь диапазон строк безграничен? Участвует весь столбец?
и еще после выполнения скрипта удаляется заголовок 17 столбца.
Обалдеть! Огромное спасибо!
разобраться бы еще в этом.
Здесь диапазон строк безграничен? Участвует весь столбец?
и еще после выполнения скрипта удаляется заголовок 17 столбца.
Неужели никто не знает
Кто подскажет макрос?
Есть таблица, то есть Счет-фактура
После заполнения первой строки, при нажатии на Enter автоматически добавляется вторая строка И тд
То есть
1 Колбаса копченная нажимаем "ENTER"
макрос в счет фактуре добавляет вторую , активную сторку
Спасибо!
Кто подскажет макрос?
Есть таблица, то есть Счет-фактура
После заполнения первой строки, при нажатии на Enter автоматически добавляется вторая строка И тд
То есть
1 Колбаса копченная нажимаем "ENTER"
макрос в счет фактуре добавляет вторую , активную сторку
Спасибо!
mistx
Цитата:
Диапазон не ограничен. Макрос работает так: Создаем два массива. массив "a" содержит элементы столбцов "A" и "B" листа "Источник", массив "b" содержит элементы столбцов "A" и "B" листа "шаблон". Затем создаем пустой массив "c", с размерностью = массиву "a". Далее, осуществляем циклическое сравнение всех элементов первой размерности массивов "a" и "b", и при совпадении, заносим в массив "c" элемент второй размерности массива "b" с тем же индексом. Для лучшего понимания, скажем, что в первой размерности находятся значения из столбцов "A", во второй - из столбцов "B". После выхода из цикла, получим массив "c", состоящий из пустых (при несовпадении) и заполненных (при совпадении) элементов, индекы которых соответствуют индексам массива "a" (т.е. строкам листа). Теперь заносим значения массива "c" в нужный столбец. Все. Итого, при работе с листами, используем всего 3 команды: формирование массивов и вставку массива. Все остальные действия происходят в памяти компьютера. Кстати, есть ли выигрыш по времени по сравнению с кодом, предложенным Вам ранее Fierce1? Если есть, то какой?
Цитата:
Перед последней строкой кода вставьте
Код: c(1, 1) = Cells(1, 17)
Цитата:
разобраться бы еще в этом.
Здесь диапазон строк безграничен? Участвует весь столбец?
Диапазон не ограничен. Макрос работает так: Создаем два массива. массив "a" содержит элементы столбцов "A" и "B" листа "Источник", массив "b" содержит элементы столбцов "A" и "B" листа "шаблон". Затем создаем пустой массив "c", с размерностью = массиву "a". Далее, осуществляем циклическое сравнение всех элементов первой размерности массивов "a" и "b", и при совпадении, заносим в массив "c" элемент второй размерности массива "b" с тем же индексом. Для лучшего понимания, скажем, что в первой размерности находятся значения из столбцов "A", во второй - из столбцов "B". После выхода из цикла, получим массив "c", состоящий из пустых (при несовпадении) и заполненных (при совпадении) элементов, индекы которых соответствуют индексам массива "a" (т.е. строкам листа). Теперь заносим значения массива "c" в нужный столбец. Все. Итого, при работе с листами, используем всего 3 команды: формирование массивов и вставку массива. Все остальные действия происходят в памяти компьютера. Кстати, есть ли выигрыш по времени по сравнению с кодом, предложенным Вам ранее Fierce1? Если есть, то какой?
Цитата:
после выполнения скрипта удаляется заголовок 17 столбца.
Перед последней строкой кода вставьте
Код: c(1, 1) = Cells(1, 17)
WowGun
window("книга1").activate не подойдет
в том-то и дело что создается не книга 1, а каждый раз окно с новым названием которое неизвестно, но известна маска окна...
window("книга1").activate не подойдет
в том-то и дело что создается не книга 1, а каждый раз окно с новым названием которое неизвестно, но известна маска окна...
SAS888
Человеческое спасибо за объяснение и помощь!
комп(2.67ГГц,ОЗУ512мб,celeron)
разница,полагаю, приличная
взял на обработку 30073 строки.
1 макрос - 4 минуты 30 секунд
ваш макрос с массивами - 2секунды
вставил c(1, 1) = Cells(1, 17)
сначала заработал, потом опять стал удалять
может я че то не так сделал
код:
Sheets("Источник").Select
Range("Q2:Q35643").Select (этото 17 столбец листа источник) очистка столбца
Selection.ClearContents
Dim i As Integer, j As Integer, a(), b(), c()
Sheets("Источник").Activate
With Sheets("шаблон")
a = Range([A1], Cells(Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value
b = .Range(.[A1], .Cells(.Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value
End With
ReDim c(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
For j = 1 To UBound(b, 1)
If a(i, 1) = b(j, 1) Then c(i, 1) = b(j, 2)
Next
Next
Range(Cells(1, 17), Cells(UBound(c, 1), 17)).Value = c
c(1, 1) = Cells(1, 17)
Человеческое спасибо за объяснение и помощь!
комп(2.67ГГц,ОЗУ512мб,celeron)
разница,полагаю, приличная
взял на обработку 30073 строки.
1 макрос - 4 минуты 30 секунд
ваш макрос с массивами - 2секунды
вставил c(1, 1) = Cells(1, 17)
сначала заработал, потом опять стал удалять
может я че то не так сделал
код:
Sheets("Источник").Select
Range("Q2:Q35643").Select (этото 17 столбец листа источник) очистка столбца
Selection.ClearContents
Dim i As Integer, j As Integer, a(), b(), c()
Sheets("Источник").Activate
With Sheets("шаблон")
a = Range([A1], Cells(Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value
b = .Range(.[A1], .Cells(.Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value
End With
ReDim c(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
For j = 1 To UBound(b, 1)
If a(i, 1) = b(j, 1) Then c(i, 1) = b(j, 2)
Next
Next
Range(Cells(1, 17), Cells(UBound(c, 1), 17)).Value = c
c(1, 1) = Cells(1, 17)
mistx
1. В коде VBA без необходимости не используйте метод Select. Очистить столбец "Q" со второй строки до конца, лучше так:
Код: Range([Q2], Cells(Rows.Count, "Q")).ClearContents
1. В коде VBA без необходимости не используйте метод Select. Очистить столбец "Q" со второй строки до конца, лучше так:
Код: Range([Q2], Cells(Rows.Count, "Q")).ClearContents
Цитата:
Привет, помоготе пожалуйста!
Если используется первый ResSQL то данные достаю(на фирме аутентификация Windows)
А если второе подключение (в данный момент закоментировано)
1. с доменном "firma\" выдает ошибку -
run-time error '-2147217543 (80040e4d)':
Недоступное имя учетной записи или пароль.
2. без домена выдает ошибку -
run-time error '-2147217843 (80040e4d)':
Не удаеться запустить приложение. Системная база данных отсутствует или открыта с монопольным доступом другим пользователем.
Файл находиться в розшариной папке на сервере SP.
Посмотрите пож. может синтаксис не правельный или я что-то не так делаю?
Спасибо.
Код:
Sub Проект()
Dim Рес, ResSQL, ПроектыВехи, f
Dim rs As New ADODB.Recordset
ResSQL = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\projectsrv\sites\MS_ProjectServer_PublicDocuments\Shared Documents\01.XLS" _
& ";Extended Properties=Excel 8.0" 'Подключение есть
'ResSQL = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\projectsrv\sites\MS_ProjectServer_PublicDocuments\Shared Documents\01.XLS" _
& ";User ID=firma\Alexandr;Password=pas;Extended Properties=Excel 8.0" 'Нет подключения
Рес = "SELECT * FROM [RESERVED_DATA1$]"
rs.Open Рес, ResSQL, adOpenStatic
While (Not rs.EOF)
ПроектыВехи = rs.GetString(adClipString)
Wend
rs.Close
End Sub
Народ помогите, может мысли у кого-то каието есть? А!
SAS888
Цитата:
понятно. у меня эта строка находилась предпоследней. Последняя была End Sub.
теперь ясно стало. поставил перед Range(Cells(1, 17), Cells(UBound(c, 1), 17)).Value = c
все теперь -ок.
Цитата:
А у Вас где расположена эта строка?
понятно. у меня эта строка находилась предпоследней. Последняя была End Sub.
теперь ясно стало. поставил перед Range(Cells(1, 17), Cells(UBound(c, 1), 17)).Value = c
все теперь -ок.
SAS888 Спасибо за внимание!
Я отметил, что речь идет про счет-фактура
Смотрите! Есть счет-фактура Начинается с РЕКВИЗИТЫ Далее, под реквизиты, колонки,
столбцы A(Наименование) B (штук) и тдC D E
потом сторка (и), где заносим информацию о товаре) а внизу, информация РУКОВОДИТЕЛЬ, ГЛАВ БУХ и тд
между ((РЕКВИЗИТЫ)) и ((РУКОВОДИТЕЛЬ, ГЛАВ БУХ и тд)) рабочая область
Столбцы (колонки) На пример, есего одна строка A9)В9)C9)D9)E9)F9)G9).....
Заполняем: (А9(колбаса) (В9(копченная) (С9(цена) и при нажатие ENTER добавляется
новая строка, передвигая РУКОВОДИТЕЛЬ, ГЛАВ БУХ и тд вниз
Спасибо!
Добавлено:
SAS888
Еще вопрос такой
Есть записанный макрос Как переписать код, чтобы он работал с указанной (активной) ячейки?
Еще раз спасибо за внимание!
Я отметил, что речь идет про счет-фактура
Смотрите! Есть счет-фактура Начинается с РЕКВИЗИТЫ Далее, под реквизиты, колонки,
столбцы A(Наименование) B (штук) и тдC D E
потом сторка (и), где заносим информацию о товаре) а внизу, информация РУКОВОДИТЕЛЬ, ГЛАВ БУХ и тд
между ((РЕКВИЗИТЫ)) и ((РУКОВОДИТЕЛЬ, ГЛАВ БУХ и тд)) рабочая область
Столбцы (колонки) На пример, есего одна строка A9)В9)C9)D9)E9)F9)G9).....
Заполняем: (А9(колбаса) (В9(копченная) (С9(цена) и при нажатие ENTER добавляется
новая строка, передвигая РУКОВОДИТЕЛЬ, ГЛАВ БУХ и тд вниз
Спасибо!
Добавлено:
SAS888
Еще вопрос такой
Есть записанный макрос Как переписать код, чтобы он работал с указанной (активной) ячейки?
Еще раз спасибо за внимание!
А что, через правый клик - "добавить ячейки" - "строку" не подходит?
По поводу
Цитата:
По поводу
Цитата:
Есть записанный макрос Как переписать код, чтобы он работал с указанной (активной) ячейки?не понял. Не экономьте слова при постановке задачи. Нужно запускать макрос по событию, или просто использовать в коде макроса активную ячейку? Что этому мешает? Если макрос запускается другим макросом, то передавайте адрес требуемой ячейки как параметр. Что нужно-то?
Добрый день! Нужна помощь.
Необходимо выделить первые десять строк отфильтрованного диапазона. Знаю как выделить весь диапазон, а как первые 10 строк не знаю. Подскажите, пожалуйста
ActiveWorkbook.Worksheets("AEB").Range("A:AA").AutoFilter Field:=2, Criteria1:="Moscow"
Sheets("AEB").AutoFilter.Sort.SortFields.Clear
Sheets("AEB").AutoFilter.Sort.SortFields.Add Key:=Range _
("AA:AA"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With Sheets("AEB").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.AutoFilter.Range.Offset(1, 0).Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1, _
ActiveSheet.AutoFilter.Range.Columns.Count).SpecialCells(xlCellTypeVisible).Select
Необходимо выделить первые десять строк отфильтрованного диапазона. Знаю как выделить весь диапазон, а как первые 10 строк не знаю. Подскажите, пожалуйста
ActiveWorkbook.Worksheets("AEB").Range("A:AA").AutoFilter Field:=2, Criteria1:="Moscow"
Sheets("AEB").AutoFilter.Sort.SortFields.Clear
Sheets("AEB").AutoFilter.Sort.SortFields.Add Key:=Range _
("AA:AA"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With Sheets("AEB").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.AutoFilter.Range.Offset(1, 0).Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1, _
ActiveSheet.AutoFilter.Range.Columns.Count).SpecialCells(xlCellTypeVisible).Select
maratino
Пробуй, этот код вставь в код листа
Код:
Private Sub Worksheet_Activate()
Application.OnKey "~", "Enter1_Sub"
Application.OnKey "{ENTER}", "Enter2_Sub"
End Sub
Пробуй, этот код вставь в код листа
Код:
Private Sub Worksheet_Activate()
Application.OnKey "~", "Enter1_Sub"
Application.OnKey "{ENTER}", "Enter2_Sub"
End Sub
Fierce1 Спасибо за отзыв!
Но что то не работает. Может я не так делаю
Но что то не работает. Может я не так делаю
Добрый вечер, помогите пожалуйста!
Необходимо найти количество нулевых элементов в каждой строке матрицы 2 на 5!!!
Подскажите как правильно прописать это в программу
Dim a(1 To 2, 1 To 5) As Single
Dim s As Integer
Dim i, j As Integer
For i = 1 To 2
For j = 1 To 5
a(i, j) = Val(InputBox( )
Next j
Next i
s = 0
Необходимо найти количество нулевых элементов в каждой строке матрицы 2 на 5!!!
Подскажите как правильно прописать это в программу
Dim a(1 To 2, 1 To 5) As Single
Dim s As Integer
Dim i, j As Integer
For i = 1 To 2
For j = 1 To 5
a(i, j) = Val(InputBox( )
Next j
Next i
s = 0
maratino
Выложи пример
Выложи пример
Grif91
Примерно так:
Код: Dim a(1 To 2, 1 To 5) As Single, s As Integer, i As Integer, j As Integer, b()
For i = 1 To 2
For j = 1 To 5
a(i, j) = Val(InputBox("Введите a(" & i & ", " & j & ")"))
Next
Next
s = 0 ' Это то, что будем искать.
ReDim b(1 To UBound(a, 1))
For i = 1 To UBound(a, 1)
b(i) = 0
For j = 1 To UBound(a, 2)
If a(i, j) = s Then b(i) = b(i) + 1
Next
Next
Примерно так:
Код: Dim a(1 To 2, 1 To 5) As Single, s As Integer, i As Integer, j As Integer, b()
For i = 1 To 2
For j = 1 To 5
a(i, j) = Val(InputBox("Введите a(" & i & ", " & j & ")"))
Next
Next
s = 0 ' Это то, что будем искать.
ReDim b(1 To UBound(a, 1))
For i = 1 To UBound(a, 1)
b(i) = 0
For j = 1 To UBound(a, 2)
If a(i, j) = s Then b(i) = b(i) + 1
Next
Next
Здравствуйте!
Помогите, пожалста, переделать скрипт для вывода списка каталогов, чтобы выводились подкаталоги(на 3 уровня в глубь). Музыка рассортирована так: D:\Music\[Стиль]\[Исполнитель]\[Год - Альбом].
Хочется добиться вывода в таком виде
Accept 1986 - Russian Roulette
Axel Rudi Pell 2007 - Diamonds Unlocked
Chrome Division 2006 - Doomsday Rock'n'Roll
Chrome Division 2008 - Booze, Broads and Beelzebub
Deep Purple 1968 - The Book Of Taliesyn
Chrome Division 1993 - Come Hell Or High Water
Def Leppard 2008 - Songs From The Sparkle Lounge
Gone Jackals 1995 - Bone to Pick
Исходный вариант(автора не знаю)
http://elv1s.ifolder.ru/11478205
Помогите, пожалста, переделать скрипт для вывода списка каталогов, чтобы выводились подкаталоги(на 3 уровня в глубь). Музыка рассортирована так: D:\Music\[Стиль]\[Исполнитель]\[Год - Альбом].
Хочется добиться вывода в таком виде
Accept 1986 - Russian Roulette
Axel Rudi Pell 2007 - Diamonds Unlocked
Chrome Division 2006 - Doomsday Rock'n'Roll
Chrome Division 2008 - Booze, Broads and Beelzebub
Deep Purple 1968 - The Book Of Taliesyn
Chrome Division 1993 - Come Hell Or High Water
Def Leppard 2008 - Songs From The Sparkle Lounge
Gone Jackals 1995 - Bone to Pick
Исходный вариант(автора не знаю)
http://elv1s.ifolder.ru/11478205
Всем здравствуйте !
оч прошу помоч мне т к сам не настолько знаю VBA ( только самое простое ( )
нужен такой скрипт :
есть 4 колонки с 10-значными числами. в каждой по 30 тыс строк минимум .
нужно сравнить между собой все колонки на совпадение 1 с 2,3,4 ; 2-ю с 1,3,4, ; 3-ю с 1,2,4 и т д и допустим в 5-й колонке выводить число которое совпало , в 6-й колонке - через запятую в каких колонках совпало и в 7-й - сколько совпадений соответственно по колонкам тоже через запятую
форму вывода данных можно варьировать чтоб удобней было , но смысл должен остаться такой !
оч прошу помощи так как мне не осилить такой скрипт вообще ((
Заранее спасибо!!!
оч прошу помоч мне т к сам не настолько знаю VBA ( только самое простое ( )
нужен такой скрипт :
есть 4 колонки с 10-значными числами. в каждой по 30 тыс строк минимум .
нужно сравнить между собой все колонки на совпадение 1 с 2,3,4 ; 2-ю с 1,3,4, ; 3-ю с 1,2,4 и т д и допустим в 5-й колонке выводить число которое совпало , в 6-й колонке - через запятую в каких колонках совпало и в 7-й - сколько совпадений соответственно по колонкам тоже через запятую
форму вывода данных можно варьировать чтоб удобней было , но смысл должен остаться такой !
оч прошу помощи так как мне не осилить такой скрипт вообще ((
Заранее спасибо!!!
(Видимо не правильно создал тему, перенес сюда)
Долго (примерно неделю) листал инет, но так и не нашел готового варианта, поскольку сам сильно не дотягиваю до уровня написания того что надо. Помогите!!! Имеем 2 списка в которых имена строк частично совпадают. в диапазоне (лист1 А1:А8500 лист2 A1:A4600) на втором листе напротив каждой строки есть значение которое необходимо присвоить такой же строке, при абсолютном совпадении, в первом листе, привожу простой пример:
лист1:
А В С
яблоко
груша
дыня
персик
ананас
слива
Лист2:
А В
груша 44
персик 33
вишня 8
и есть один ньюанс необходимо в процессе работы создать еще 2 листа, т.е. Лист3 и лист 4 в который будут переноситься те строки которые остались уникальны в первых 2х листах, только обязательно целые строки т.к. в первой таблице после пустого столбца "В" далее продолжаются строки данных, т.е. опять пример для понятности происходящего:
лист3
А В
Вишня 8
Лист 4
А В С D
Яблоко
Ананас
Слива
Надеюсь смог понятно донести проблемму.
Долго (примерно неделю) листал инет, но так и не нашел готового варианта, поскольку сам сильно не дотягиваю до уровня написания того что надо. Помогите!!! Имеем 2 списка в которых имена строк частично совпадают. в диапазоне (лист1 А1:А8500 лист2 A1:A4600) на втором листе напротив каждой строки есть значение которое необходимо присвоить такой же строке, при абсолютном совпадении, в первом листе, привожу простой пример:
лист1:
А В С
яблоко
груша
дыня
персик
ананас
слива
Лист2:
А В
груша 44
персик 33
вишня 8
и есть один ньюанс необходимо в процессе работы создать еще 2 листа, т.е. Лист3 и лист 4 в который будут переноситься те строки которые остались уникальны в первых 2х листах, только обязательно целые строки т.к. в первой таблице после пустого столбца "В" далее продолжаются строки данных, т.е. опять пример для понятности происходящего:
лист3
А В
Вишня 8
Лист 4
А В С D
Яблоко
Ананас
Слива
Надеюсь смог понятно донести проблемму.
reanews1
Инет листал неделю, а эту тему даже и не смотрел. Посмотри 161 страницу, там у mistx была аналогичная задача
Инет листал неделю, а эту тему даже и не смотрел. Посмотри 161 страницу, там у mistx была аналогичная задача
Вобщем непонятки какието вышли... Я попытаюсь еще раз объяснить что получается, а что нет (поскольку после вставки кода с листа 161 макрос очищает лист "шаблона и считает что отделался.) Опишу то как делаю это я, но думаю что это танцы с бубном народов крайнего севера)))
Я уже нашел код с сайта Микрософта:
Sub DelDups_TwoLists()
Dim iListCount As Integer
Dim iCtr As Integer
Application.ScreenUpdating = False
iListCount = Sheets("Sheet2").Range("A1:A7715").Rows.Count
For Each x In Sheets("Sheet1").Range("A1:A4878")
For iCtr = 1 To iListCount
If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
Sheets("Sheet2").Cells(iCtr, 1).Clear
iCtr = iCtr + 1
End If
Next iCtr
Next
Application.ScreenUpdating = True
MsgBox "Готово"
End Sub
Только этот код удалял ячейки в столбце со сдвигов вверх, а напротив этих ячеек есть значения и в итоге получается путаница,
Sheets("Sheet2").Cells(iCtr, 1).Delete xlShiftUp
И поэтому пришлось заменить на:
Sheets("Sheet2").Cells(iCtr, 1).Clear
в итоге аолучается список с пустыми ячейками, напротив которого через нескколько строк я вставляю такой же, делаю фильтр по уже пустым ячейкам и остается то чего макрос не нашел на перввом листе и копирую значения на 3й лист, далее сортирую как все Не пустые и в правом листе остаються только те значения которые он нашел и опять копирую на 4й уже лист, а потом предполагаю поменять названия листов sheet1 на sheet2 и сделать наоборот и тогда у меня останется только уникальные значения из второго списка. Ну вот както так... Так что ситуация несколько не та, насколько я понимаю и эту ветку форума я изучил вроде.
Это слишком долго получается. сортировка на 1ядерном пне 2.2Гц 1,5Гб оперативы длиться 2часа примерно с небольшим. а тут надо минимум 2 раза сортировать....
Я уже нашел код с сайта Микрософта:
Sub DelDups_TwoLists()
Dim iListCount As Integer
Dim iCtr As Integer
Application.ScreenUpdating = False
iListCount = Sheets("Sheet2").Range("A1:A7715").Rows.Count
For Each x In Sheets("Sheet1").Range("A1:A4878")
For iCtr = 1 To iListCount
If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
Sheets("Sheet2").Cells(iCtr, 1).Clear
iCtr = iCtr + 1
End If
Next iCtr
Next
Application.ScreenUpdating = True
MsgBox "Готово"
End Sub
Только этот код удалял ячейки в столбце со сдвигов вверх, а напротив этих ячеек есть значения и в итоге получается путаница,
Sheets("Sheet2").Cells(iCtr, 1).Delete xlShiftUp
И поэтому пришлось заменить на:
Sheets("Sheet2").Cells(iCtr, 1).Clear
в итоге аолучается список с пустыми ячейками, напротив которого через нескколько строк я вставляю такой же, делаю фильтр по уже пустым ячейкам и остается то чего макрос не нашел на перввом листе и копирую значения на 3й лист, далее сортирую как все Не пустые и в правом листе остаються только те значения которые он нашел и опять копирую на 4й уже лист, а потом предполагаю поменять названия листов sheet1 на sheet2 и сделать наоборот и тогда у меня останется только уникальные значения из второго списка. Ну вот както так... Так что ситуация несколько не та, насколько я понимаю и эту ветку форума я изучил вроде.
Это слишком долго получается. сортировка на 1ядерном пне 2.2Гц 1,5Гб оперативы длиться 2часа примерно с небольшим. а тут надо минимум 2 раза сортировать....
Страницы: 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133
Предыдущая тема: Написание своего HyperTerminal для считывания данных
Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.