библиотеки, которые были установлены вместе с какой-либо надстройкой в excel или подключены напрямую к проекту, когда создавался этот файл, а сейчас их нет (по крайней мере у нас) возможно, они у ТС остались подключены к excel 2003, тогда можно посмотреть в 2003 какие файлы там подключены и перенести их в 2010
библиотеки, которые были установлены вместе с какой-либо надстройкой в excel или подключены напрямую к проекту, когда создавался этот файл, а сейчас их нет (по крайней мере у нас) возможно, они у ТС остались подключены к excel 2003, тогда можно посмотреть в 2003 какие файлы там подключены и перенести их в 2010krosav4ig
Sub djon2012() Dim SH1 As Worksheet, SH2 As Worksheet, rng As Range Set SH1 = ThisWorkbook.Sheets("Лист2") Set SH2 = ThisWorkbook.Sheets("Лист3") Application.ScreenUpdating = 0 Do: With SH1.[DA:DA].SpecialCells(xlCellTypeFormulas, 1).Offset(, 1) .FormulaR1C1 = "=IF(RC[-1]=6,RC[-1])": On Error Resume Next Set rng = .SpecialCells(xlCellTypeFormulas, 1) If rng Is Nothing Then .ClearContents: Exit Do Else: Intersect(SH1.[M:CZ], rng.EntireRow).Copy SH2.[C2].Offset(Application.CountA(SH2.[C:C])).PasteSpecial Paste:=xlPasteAll, Operation:=2 .ClearContents: Sheets.Select: SH1.[A1].Select: SH1.Select: End With: Loop Until True Application.ScreenUpdating = 1 End Sub
[/vba]
еще вариант, без циклов [vba]
Код
Sub djon2012() Dim SH1 As Worksheet, SH2 As Worksheet, rng As Range Set SH1 = ThisWorkbook.Sheets("Лист2") Set SH2 = ThisWorkbook.Sheets("Лист3") Application.ScreenUpdating = 0 Do: With SH1.[DA:DA].SpecialCells(xlCellTypeFormulas, 1).Offset(, 1) .FormulaR1C1 = "=IF(RC[-1]=6,RC[-1])": On Error Resume Next Set rng = .SpecialCells(xlCellTypeFormulas, 1) If rng Is Nothing Then .ClearContents: Exit Do Else: Intersect(SH1.[M:CZ], rng.EntireRow).Copy SH2.[C2].Offset(Application.CountA(SH2.[C:C])).PasteSpecial Paste:=xlPasteAll, Operation:=2 .ClearContents: Sheets.Select: SH1.[A1].Select: SH1.Select: End With: Loop Until True Application.ScreenUpdating = 1 End Sub
вот функция для получения котировок на металлы Сбербанка 1 атрибут функции обязательный - код металла (1 - золото, 6 - серебро, 28 - платина, 29 - палладий) 2 атрибут необязательный- тип курса банка ("buy" , "sell", по умолчанию "buy") 3 атрибут необязательный - дата в числовом или текстовом формате (по умолчанию текущая системная дата) в качестве разделителей между числами дня, месяца и года может использоваться любой символ из " " , "/" , "." , "-" , "," , запись даты в формате "9 янв 15" и "9 января 2015" тоже корректно распознаются 4 атрибут необязательный - код региона (по умолчанию 223 - Москва) [vba]
Код
Function МетСБР#(CodeMet%, Optional quote$ = "buy", Optional dDate As Date, Optional region% = 223) Dim sc: Set sc = CreateObject("ScriptControl"):dDate = IIf(dDate, dDate, Date):sc.Language = "JScript" sc.AddCode "function getProperty(jsonObj, propertyName) {return jsonObj[propertyName];}" sc.AddCode "function getKeys(jsonObj) {var keys=new Array();for(var i in jsonObj){keys.push(i);}return keys;}" strURL = "http://sbrf.ru/common/js/get_quote_values.php?&inf_block=" & region & "&group=2&_date_afrom114=" _ & dDate & "&_date_ato114=" & dDate & "&qid[]=" & CodeMet Dim XMLhttp: Set XMLhttp = CreateObject("msxml2.xmlhttp"): XMLhttp.Open "POST", strURL, 0: XMLhttp.send МетСБР = sc.Run("getProperty", sc.Run("getProperty", sc.Run("getProperty", _ sc.Run("getProperty", sc.Eval("(" & XMLhttp.responsetext & ")"), CodeMet), _ "quotes"), sc.Run("getKeys", sc.Run("getProperty", sc.Run("getProperty", _ sc.Eval("(" & XMLhttp.responsetext & ")"), CodeMet), "quotes"))), quote) Set XMLhttp = Nothing: Set sc = Nothing End Function
[/vba]
вот функция для получения котировок на металлы Сбербанка 1 атрибут функции обязательный - код металла (1 - золото, 6 - серебро, 28 - платина, 29 - палладий) 2 атрибут необязательный- тип курса банка ("buy" , "sell", по умолчанию "buy") 3 атрибут необязательный - дата в числовом или текстовом формате (по умолчанию текущая системная дата) в качестве разделителей между числами дня, месяца и года может использоваться любой символ из " " , "/" , "." , "-" , "," , запись даты в формате "9 янв 15" и "9 января 2015" тоже корректно распознаются 4 атрибут необязательный - код региона (по умолчанию 223 - Москва) [vba]
Код
Function МетСБР#(CodeMet%, Optional quote$ = "buy", Optional dDate As Date, Optional region% = 223) Dim sc: Set sc = CreateObject("ScriptControl"):dDate = IIf(dDate, dDate, Date):sc.Language = "JScript" sc.AddCode "function getProperty(jsonObj, propertyName) {return jsonObj[propertyName];}" sc.AddCode "function getKeys(jsonObj) {var keys=new Array();for(var i in jsonObj){keys.push(i);}return keys;}" strURL = "http://sbrf.ru/common/js/get_quote_values.php?&inf_block=" & region & "&group=2&_date_afrom114=" _ & dDate & "&_date_ato114=" & dDate & "&qid[]=" & CodeMet Dim XMLhttp: Set XMLhttp = CreateObject("msxml2.xmlhttp"): XMLhttp.Open "POST", strURL, 0: XMLhttp.send МетСБР = sc.Run("getProperty", sc.Run("getProperty", sc.Run("getProperty", _ sc.Run("getProperty", sc.Eval("(" & XMLhttp.responsetext & ")"), CodeMet), _ "quotes"), sc.Run("getKeys", sc.Run("getProperty", sc.Run("getProperty", _ sc.Eval("(" & XMLhttp.responsetext & ")"), CodeMet), "quotes"))), quote) Set XMLhttp = Nothing: Set sc = Nothing End Function
Наконец-то дополз до компа Переписал запрос Все, теперь он выводит сформированную вашу таблицу1 на лист Все (данные берутся из таблиц на Листе1), добавил фильтрацию в запросы по городам.
Наконец-то дополз до компа Переписал запрос Все, теперь он выводит сформированную вашу таблицу1 на лист Все (данные берутся из таблиц на Листе1), добавил фильтрацию в запросы по городам.krosav4ig
еще вариант с использованием надстройки Power Query заполняем таблицы городов на 1м листе, жмем Ctrl+Alt+F5 и получаем готовую таблицу Все (в столбцах B:E Листа1) и таблицы городов на соответствующих листах
еще вариант с использованием надстройки Power Query заполняем таблицы городов на 1м листе, жмем Ctrl+Alt+F5 и получаем готовую таблицу Все (в столбцах B:E Листа1) и таблицы городов на соответствующих листахkrosav4ig
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
