Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Записи участника (krosav4ig) - Мир MS Excel

Результаты поиска
krosav4ig Дата: Среда, 21.08.2019, 21:25 | Сообщение № 201 | Тема: Снять выделение в Комбоксе
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Run-time error '424':
Object required
на форму нужно поместить невидимый текстбокс с именем TextBox1


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Среда, 21.08.2019, 21:26
 
Ответить
Сообщение
Run-time error '424':
Object required
на форму нужно поместить невидимый текстбокс с именем TextBox1

Автор - krosav4ig
Дата добавления - 21.08.2019 в 21:25
krosav4ig Дата: Среда, 21.08.2019, 21:23 | Сообщение № 202 | Тема: Снять выделение в Комбоксе
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
ну и до кучи, если форма немодальная, то достаточно просто .SetFocus [vba]
Код
Private Sub UserForm_Initialize()
   '   Fill the ComboBoxes
    With comboComments
        .List = Array("Только индикатор", "Скрыть", "Показать")
    End With
    '   Get the current settings
    With Parent
        cbFullScreen = .DisplayFullScreen
        comboComments.ListIndex = .DisplayCommentIndicator + 1
    End With
End Sub
Private Sub comboComments_Change()
    With comboComments
        .SetFocus
        Application.DisplayCommentIndicator = .ListIndex - 1
    End With
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениену и до кучи, если форма немодальная, то достаточно просто .SetFocus [vba]
Код
Private Sub UserForm_Initialize()
   '   Fill the ComboBoxes
    With comboComments
        .List = Array("Только индикатор", "Скрыть", "Показать")
    End With
    '   Get the current settings
    With Parent
        cbFullScreen = .DisplayFullScreen
        comboComments.ListIndex = .DisplayCommentIndicator + 1
    End With
End Sub
Private Sub comboComments_Change()
    With comboComments
        .SetFocus
        Application.DisplayCommentIndicator = .ListIndex - 1
    End With
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 21.08.2019 в 21:23
krosav4ig Дата: Среда, 21.08.2019, 19:49 | Сообщение № 203 | Тема: Снять выделение в Комбоксе
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Тогда ошибка:
Compile error:
Case without Select Case

ну дык зачем было удалять строку
[vba]
Код
    Select Case comboComments.ListIndex
[/vba]?
появилась пустая строка вверху ее тоже надо убрать.

Кто вам мешает это сделать?
Главное чтобы нужная задачка выполнялась.
читаем заголовок темы и первый пост
Снять выделение в Комбоксе

как убрать выделение при запуске формы
код из #7 на 100% этой задаче соответствует
снятие выделения комбобокса
[vba]
Код
comboComments.ListIndex = -1
[/vba]напишете эту строку сами там, где вам нужно выделение снять


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
Тогда ошибка:
Compile error:
Case without Select Case

ну дык зачем было удалять строку
[vba]
Код
    Select Case comboComments.ListIndex
[/vba]?
появилась пустая строка вверху ее тоже надо убрать.

Кто вам мешает это сделать?
Главное чтобы нужная задачка выполнялась.
читаем заголовок темы и первый пост
Снять выделение в Комбоксе

как убрать выделение при запуске формы
код из #7 на 100% этой задаче соответствует
снятие выделения комбобокса
[vba]
Код
comboComments.ListIndex = -1
[/vba]напишете эту строку сами там, где вам нужно выделение снять

Автор - krosav4ig
Дата добавления - 21.08.2019 в 19:49
krosav4ig Дата: Среда, 21.08.2019, 14:07 | Сообщение № 204 | Тема: Снять выделение в Комбоксе
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Добрый день
как убрать выделение при запуске формы.
в UserForm_Initialize удалить строки, которые выделение устанавливают (содержащие [vba]
Код
comboComments.ListIndex =
[/vba])


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеДобрый день
как убрать выделение при запуске формы.
в UserForm_Initialize удалить строки, которые выделение устанавливают (содержащие [vba]
Код
comboComments.ListIndex =
[/vba])

Автор - krosav4ig
Дата добавления - 21.08.2019 в 14:07
krosav4ig Дата: Вторник, 20.08.2019, 21:55 | Сообщение № 205 | Тема: Построение квадрата Ганна 9
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
у меня так и не нашлось времени сократить свою формулу в 325 символов
Код
=ЕСЛИ(ABS($A$1-СТОЛБЕЦ())>ABS($A$1-СТРОКА());(($A$1-СТОЛБЕЦ())^2-(-1)^(СТОЛБЕЦ()>$A$1)*($A$1-СТОЛБЕЦ()))*4+($A$1-СТОЛБЕЦ())*(-5)^(СТОЛБЕЦ()>$A$1)+1+($A$1-СТРОКА())*(-1)^(СТОЛБЕЦ()>$A$1);(($A$1-СТРОКА())^2-(-1)^(СТРОКА()>$A$1)*($A$1-СТРОКА()))*4+3*(-7/3)^(СТРОКА()>$A$1)*($A$1-СТРОКА())+1+($A$1-СТОЛБЕЦ())*(-1)^(СТРОКА()<$A$1))


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеу меня так и не нашлось времени сократить свою формулу в 325 символов
Код
=ЕСЛИ(ABS($A$1-СТОЛБЕЦ())>ABS($A$1-СТРОКА());(($A$1-СТОЛБЕЦ())^2-(-1)^(СТОЛБЕЦ()>$A$1)*($A$1-СТОЛБЕЦ()))*4+($A$1-СТОЛБЕЦ())*(-5)^(СТОЛБЕЦ()>$A$1)+1+($A$1-СТРОКА())*(-1)^(СТОЛБЕЦ()>$A$1);(($A$1-СТРОКА())^2-(-1)^(СТРОКА()>$A$1)*($A$1-СТРОКА()))*4+3*(-7/3)^(СТРОКА()>$A$1)*($A$1-СТРОКА())+1+($A$1-СТОЛБЕЦ())*(-1)^(СТРОКА()<$A$1))

Автор - krosav4ig
Дата добавления - 20.08.2019 в 21:55
krosav4ig Дата: Суббота, 17.08.2019, 17:45 | Сообщение № 206 | Тема: формат ячейки с верхним индексом
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
для Excel <=2010
[vba]
Код
Function UniChr(Code&)
    UniChr = ChrW(Code)
End Function
[/vba]
Код
=ЛЕВБ(A1;ПОИСК(" ";A1)-1)&UniChr(8314)&ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПСТР(A1;ПОИСК("–";A1)+2;99)-ЛЕВБ(A1;ПОИСК(" ";A1));0;UniChr(8304));1;UniChr(185));2;UniChr(178));3;UniChr(179));4;UniChr(8308));5;UniChr(8309));6;UniChr(8310));7;UniChr(8311));8;UniChr(8312));9;UniChr(8313));",";UniChr(B2))

для Excel >=2013
Код
=ЛЕВБ(A1;ПОИСК(" ";A1)-1)&ЮНИСИМВ(8314)&ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПСТР(A1;ПОИСК("–";A1)+2;99)-ЛЕВБ(A1;ПОИСК(" ";A1));0;ЮНИСИМВ(8304));1;ЮНИСИМВ(185));2;ЮНИСИМВ(178));3;ЮНИСИМВ(179));4;ЮНИСИМВ(8308));5;ЮНИСИМВ(8309));6;ЮНИСИМВ(8310));7;ЮНИСИМВ(8311));8;ЮНИСИМВ(8312));9;ЮНИСИМВ(8313));",";ЮНИСИМВ(B2))


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениедля Excel <=2010
[vba]
Код
Function UniChr(Code&)
    UniChr = ChrW(Code)
End Function
[/vba]
Код
=ЛЕВБ(A1;ПОИСК(" ";A1)-1)&UniChr(8314)&ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПСТР(A1;ПОИСК("–";A1)+2;99)-ЛЕВБ(A1;ПОИСК(" ";A1));0;UniChr(8304));1;UniChr(185));2;UniChr(178));3;UniChr(179));4;UniChr(8308));5;UniChr(8309));6;UniChr(8310));7;UniChr(8311));8;UniChr(8312));9;UniChr(8313));",";UniChr(B2))

для Excel >=2013
Код
=ЛЕВБ(A1;ПОИСК(" ";A1)-1)&ЮНИСИМВ(8314)&ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПСТР(A1;ПОИСК("–";A1)+2;99)-ЛЕВБ(A1;ПОИСК(" ";A1));0;ЮНИСИМВ(8304));1;ЮНИСИМВ(185));2;ЮНИСИМВ(178));3;ЮНИСИМВ(179));4;ЮНИСИМВ(8308));5;ЮНИСИМВ(8309));6;ЮНИСИМВ(8310));7;ЮНИСИМВ(8311));8;ЮНИСИМВ(8312));9;ЮНИСИМВ(8313));",";ЮНИСИМВ(B2))

Автор - krosav4ig
Дата добавления - 17.08.2019 в 17:45
krosav4ig Дата: Пятница, 16.08.2019, 23:22 | Сообщение № 207 | Тема: элемент управления Флажок на три ячейки
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте
в модуль [vba]
Код
Function xx(ParamArray r() As Variant) As Range
    Dim rng, b As Boolean
    If Application.Caller.Address = ActiveCell.Address Then
        Set xx = r(0).Cells(1, 1)
        b = xx
        For Each rng In r
            rng.Value = Not b
        Next
    End If
End Function
[/vba]
в диспетчер имен именованный диапазон
x
Код
=xx((Лист1!$B$2;Лист1!$D$2;Лист1!$B$5;Лист1!$D$5))
или, например,
Код
=xx(Лист1!$F$2:$F$3;Лист1!$H$2:$H$3;Лист1!$F$5:$F$6)

выделяем флажок, в строке формул пишем =x
К сообщению приложен файл: 9648676.xlsm (16.2 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте
в модуль [vba]
Код
Function xx(ParamArray r() As Variant) As Range
    Dim rng, b As Boolean
    If Application.Caller.Address = ActiveCell.Address Then
        Set xx = r(0).Cells(1, 1)
        b = xx
        For Each rng In r
            rng.Value = Not b
        Next
    End If
End Function
[/vba]
в диспетчер имен именованный диапазон
x
Код
=xx((Лист1!$B$2;Лист1!$D$2;Лист1!$B$5;Лист1!$D$5))
или, например,
Код
=xx(Лист1!$F$2:$F$3;Лист1!$H$2:$H$3;Лист1!$F$5:$F$6)

выделяем флажок, в строке формул пишем =x

Автор - krosav4ig
Дата добавления - 16.08.2019 в 23:22
krosav4ig Дата: Пятница, 16.08.2019, 18:54 | Сообщение № 208 | Тема: Запись значения конкретной ячейки в заданную другую
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$B$12" Then Exit Sub
    Cells((([F15] - 1) \ 3 + 1) * 2, 4 - (([F15] - 1) Mod 3)) = Target
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$B$12" Then Exit Sub
    Cells((([F15] - 1) \ 3 + 1) * 2, 4 - (([F15] - 1) Mod 3)) = Target
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 16.08.2019 в 18:54
krosav4ig Дата: Пятница, 16.08.2019, 00:12 | Сообщение № 209 | Тема: Обход ограничения на кол-во символов в ячейке
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
какая у вас структура данных?
написал себе для для теста
[vba]
Код
function myFunction() {
    var ss = SpreadsheetApp.getActive();
    var sheet = ss.getSheetByName("Лист1");
    var data = BtwBraces(Array.apply(null, Array(3000)).reduce(function(a, b) {
        return a + "{" + Array.apply(null, Array(Math.floor(Math.random() * 20) + 1)).reduce(function(a, b) {
            a.push("\"" + Array.apply(null, Array(2)).reduce(function(a, b) {
                a.push(Math.random(this).toString(36).slice(2, Math.floor(Math.random() * 10) + 3));
                return a
            }, []).join("\":\"") + "\"");
            return a
        }, []).join(",") + "}"
    }, ""));
    var raw = sheet.getRange(1, 1).offset(0, 0, data.length).setValues(data);
}
function BtwBraces(a) {
    return a.split(/[{}]/g).
    filter(function(a) {return a}).
    map(function(a) {return [a]})
}
[/vba]
все нормально отабатвает


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Пятница, 16.08.2019, 00:14
 
Ответить
Сообщениекакая у вас структура данных?
написал себе для для теста
[vba]
Код
function myFunction() {
    var ss = SpreadsheetApp.getActive();
    var sheet = ss.getSheetByName("Лист1");
    var data = BtwBraces(Array.apply(null, Array(3000)).reduce(function(a, b) {
        return a + "{" + Array.apply(null, Array(Math.floor(Math.random() * 20) + 1)).reduce(function(a, b) {
            a.push("\"" + Array.apply(null, Array(2)).reduce(function(a, b) {
                a.push(Math.random(this).toString(36).slice(2, Math.floor(Math.random() * 10) + 3));
                return a
            }, []).join("\":\"") + "\"");
            return a
        }, []).join(",") + "}"
    }, ""));
    var raw = sheet.getRange(1, 1).offset(0, 0, data.length).setValues(data);
}
function BtwBraces(a) {
    return a.split(/[{}]/g).
    filter(function(a) {return a}).
    map(function(a) {return [a]})
}
[/vba]
все нормально отабатвает

Автор - krosav4ig
Дата добавления - 16.08.2019 в 00:12
krosav4ig Дата: Четверг, 15.08.2019, 07:47 | Сообщение № 210 | Тема: Обход ограничения на кол-во символов в ячейке
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
тупо делим на куски по 5к символов
[vba]
Код
function commas() {
var key = 'api';
var secret = 'secret';

var baseUrl = "https://exchange.com";
var endPoint = "/public/api/ver1/smart_trades";
var pointParams = "?account_id=xxx&scope=finished";
var queryString = endPoint + pointParams;
var signature = Utilities.computeHmacSha256Signature(queryString, secret);
signature = signature.map(function(e) {return ("0" + (e < 0 ? e + 256 : e).toString(16)).slice(-2)}).join("");

var hparams = {
    'method': 'get',
    'headers': {'APIKEY': key,
                'Signature': signature},
    'muteHttpExceptions': true
};

var data = chunk(UrlFetchApp.fetch(baseUrl + queryString , hparams).getContentText(),5000);
Logger.log(data)
var ss = SpreadsheetApp.getActive();
var sheet = ss.getSheetByName("rates");
var raw = sheet.getRange(13,1).offset(0, 0, data.length).setValue(data)
}
function chunk(a,b){
  return Array.apply(null, new Array(Math.ceil(a.length/b))).
  map(function (c, d) {return [a.substr(d*b,b)];});
}
[/vba]или делим строку по скобкам [vba]
Код
var data = BtwBraces(UrlFetchApp.fetch(baseUrl + queryString , hparams).getContentText());
[/vba]
[vba]
Код
function BtwBraces(a){
  return a.split(/[{}]/g).
  filter(function(a){return a;}).
  map(function (a){return [a];})
}
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 15.08.2019, 07:47
 
Ответить
Сообщениетупо делим на куски по 5к символов
[vba]
Код
function commas() {
var key = 'api';
var secret = 'secret';

var baseUrl = "https://exchange.com";
var endPoint = "/public/api/ver1/smart_trades";
var pointParams = "?account_id=xxx&scope=finished";
var queryString = endPoint + pointParams;
var signature = Utilities.computeHmacSha256Signature(queryString, secret);
signature = signature.map(function(e) {return ("0" + (e < 0 ? e + 256 : e).toString(16)).slice(-2)}).join("");

var hparams = {
    'method': 'get',
    'headers': {'APIKEY': key,
                'Signature': signature},
    'muteHttpExceptions': true
};

var data = chunk(UrlFetchApp.fetch(baseUrl + queryString , hparams).getContentText(),5000);
Logger.log(data)
var ss = SpreadsheetApp.getActive();
var sheet = ss.getSheetByName("rates");
var raw = sheet.getRange(13,1).offset(0, 0, data.length).setValue(data)
}
function chunk(a,b){
  return Array.apply(null, new Array(Math.ceil(a.length/b))).
  map(function (c, d) {return [a.substr(d*b,b)];});
}
[/vba]или делим строку по скобкам [vba]
Код
var data = BtwBraces(UrlFetchApp.fetch(baseUrl + queryString , hparams).getContentText());
[/vba]
[vba]
Код
function BtwBraces(a){
  return a.split(/[{}]/g).
  filter(function(a){return a;}).
  map(function (a){return [a];})
}
[/vba]

Автор - krosav4ig
Дата добавления - 15.08.2019 в 07:47
krosav4ig Дата: Понедельник, 12.08.2019, 22:21 | Сообщение № 211 | Тема: Исчезновение(обнуление) данных из ячейки
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте,
мышка пробежала, хвостиком махнула, Delete нажала


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте,
мышка пробежала, хвостиком махнула, Delete нажала

Автор - krosav4ig
Дата добавления - 12.08.2019 в 22:21
krosav4ig Дата: Воскресенье, 11.08.2019, 21:47 | Сообщение № 212 | Тема: Как сделать таблицу для соревнований по Швейцарской системе?
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте
Swiss Pairing algorithm in excel to organize a chess tournament

Автор - krosav4ig
Дата добавления - 11.08.2019 в 21:47
krosav4ig Дата: Воскресенье, 11.08.2019, 06:26 | Сообщение № 213 | Тема: Сортировка списка
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте
Данные -> Сортировка
К сообщению приложен файл: 0607300.png (53.6 Kb) · 0-5_.xls (88.0 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте
Данные -> Сортировка

Автор - krosav4ig
Дата добавления - 11.08.2019 в 06:26
krosav4ig Дата: Суббота, 10.08.2019, 23:57 | Сообщение № 214 | Тема: Построение квадрата Ганна 9
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Доброго времени суток.
325 без =
как сократить пока мыслей нет


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеДоброго времени суток.
325 без =
как сократить пока мыслей нет

Автор - krosav4ig
Дата добавления - 10.08.2019 в 23:57
krosav4ig Дата: Четверг, 08.08.2019, 17:34 | Сообщение № 215 | Тема: Добавление листов в коллекцию
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[vba]
Код
Option Explicit
Function UsedRangeByCodeName(sCodeName$) As Range
    Set UsedRangeByCodeName = ThisWorkbook.VBProject. _
        VBComponents(sCodeName). _
        Properties("usedrange").Object
End Function
Sub test()
    Dim MyCollection As New Collection
    Dim v, r As Range, r1 As Range, r2 As Range, addr$
    For Each v In Array("Лист3", "Лист4")
        MyCollection.Add UsedRangeByCodeName(CStr(v)), v
    Next
    With Application.FindFormat
        .Clear
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = vbBlue
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End With
    For Each r In MyCollection
        Set r1 = r.Find(What:="", After:=r(1, 1), LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True)
        If Not r1 Is Nothing Then
            addr = r1.Address
            Set r2 = r1
            Do
                If r1.Address <> addr Then Set r2 = Union(r2, r1)
                Set r1 = r.Find(What:="", After:=r1, LookIn:=xlFormulas, LookAt:= _
                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                    , SearchFormat:=True)
            Loop While Not r1 Is Nothing And r1.Address <> addr
        End If
        If Not r2 Is Nothing Then r2.Interior.Color = 255: Set r2 = Nothing
    Next
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 08.08.2019, 17:57
 
Ответить
Сообщение[vba]
Код
Option Explicit
Function UsedRangeByCodeName(sCodeName$) As Range
    Set UsedRangeByCodeName = ThisWorkbook.VBProject. _
        VBComponents(sCodeName). _
        Properties("usedrange").Object
End Function
Sub test()
    Dim MyCollection As New Collection
    Dim v, r As Range, r1 As Range, r2 As Range, addr$
    For Each v In Array("Лист3", "Лист4")
        MyCollection.Add UsedRangeByCodeName(CStr(v)), v
    Next
    With Application.FindFormat
        .Clear
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = vbBlue
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End With
    For Each r In MyCollection
        Set r1 = r.Find(What:="", After:=r(1, 1), LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True)
        If Not r1 Is Nothing Then
            addr = r1.Address
            Set r2 = r1
            Do
                If r1.Address <> addr Then Set r2 = Union(r2, r1)
                Set r1 = r.Find(What:="", After:=r1, LookIn:=xlFormulas, LookAt:= _
                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                    , SearchFormat:=True)
            Loop While Not r1 Is Nothing And r1.Address <> addr
        End If
        If Not r2 Is Nothing Then r2.Interior.Color = 255: Set r2 = Nothing
    Next
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 08.08.2019 в 17:34
krosav4ig Дата: Вторник, 06.08.2019, 23:26 | Сообщение № 216 | Тема: Добавление листов в коллекцию
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте
наваял что-то такое, но не работает
а должно?[vba]
Код
Dim sh As Worksheet
    For Each sh In Sheets(Array("Лист3", "Лист4"))
        With sh.UsedRange.Interior
            If .Color = vbRed Then .Color = vbBlue Else .Color = vbRed
        End With
    Next
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Вторник, 06.08.2019, 23:26
 
Ответить
СообщениеЗдравствуйте
наваял что-то такое, но не работает
а должно?[vba]
Код
Dim sh As Worksheet
    For Each sh In Sheets(Array("Лист3", "Лист4"))
        With sh.UsedRange.Interior
            If .Color = vbRed Then .Color = vbBlue Else .Color = vbRed
        End With
    Next
[/vba]

Автор - krosav4ig
Дата добавления - 06.08.2019 в 23:26
krosav4ig Дата: Понедельник, 05.08.2019, 20:23 | Сообщение № 217 | Тема: Kонвертация Power Point в Pdf
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
при нажатии кнопок Alt+ЕМБ
при последовательном нажатии - открывает только вкладку Tools
надо было жать не в окне vbe, а в окне книги
но вот у меня в ENG варианте оно другое

ну да, в ENG это Alt+TMS


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
при нажатии кнопок Alt+ЕМБ
при последовательном нажатии - открывает только вкладку Tools
надо было жать не в окне vbe, а в окне книги
но вот у меня в ENG варианте оно другое

ну да, в ENG это Alt+TMS

Автор - krosav4ig
Дата добавления - 05.08.2019 в 20:23
krosav4ig Дата: Понедельник, 05.08.2019, 18:53 | Сообщение № 218 | Тема: Закраска разделов документа word, с учетом текста строки
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
у меня в word 2003, 2007, 2010, 2013 отрабатывает без ошибок
раскрашенные файлы прилагаю

upd.
немного переписал код
пробуйте так
[vba]
Код

Sub colorize()
          Dim p As Paragraph, prev&, b As Boolean
1         On Error GoTo colorize_Error

11        Application.ScreenUpdating = 0
21        With CreateObject("vbscript.regexp")
31            .Global = False: .Pattern = "^\d+\.\d+\s"
41            For Each p In ThisDocument.Paragraphs
51                If p.Next Is Nothing Then
61                    If .test(p.Range.Text) Then
71                        p.Range.HighlightColorIndex = IIf(b, 3, 7)
81                    ElseIf prev > 0 Then
91                        p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
101                   End If
111               ElseIf .test(p.Range.Text) Then
121                   If prev > 0 Then
131                       p.Parent.Range(prev - 1, p.Previous.Range.End).HighlightColorIndex = IIf(b, 3, 7)
141                   End If
151                   b = Not b
161                   prev = p.Range.Start + 1
171               End If
181           Next
191       End With
201       Application.ScreenUpdating = 1
211       On Error GoTo 0
221       Exit Sub
colorize_Error:
231       MsgBox "Error " & Err.Number & " (" & Err.Description & _
              ") in procedure colorize of VBA Document ThisDocument on line " & Erl & vbLf & _
              "paragraphs.count: " & Paragraphs.Count & ",  current paragraph: " & Range(0, _
              p.Range.End).Paragraphs.Count
End Sub
[/vba]
К сообщению приложен файл: 111-.zip (40.0 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 05.08.2019, 19:58
 
Ответить
Сообщениеу меня в word 2003, 2007, 2010, 2013 отрабатывает без ошибок
раскрашенные файлы прилагаю

upd.
немного переписал код
пробуйте так
[vba]
Код

Sub colorize()
          Dim p As Paragraph, prev&, b As Boolean
1         On Error GoTo colorize_Error

11        Application.ScreenUpdating = 0
21        With CreateObject("vbscript.regexp")
31            .Global = False: .Pattern = "^\d+\.\d+\s"
41            For Each p In ThisDocument.Paragraphs
51                If p.Next Is Nothing Then
61                    If .test(p.Range.Text) Then
71                        p.Range.HighlightColorIndex = IIf(b, 3, 7)
81                    ElseIf prev > 0 Then
91                        p.Parent.Range(prev - 1, p.Range.End).HighlightColorIndex = IIf(b, 3, 7)
101                   End If
111               ElseIf .test(p.Range.Text) Then
121                   If prev > 0 Then
131                       p.Parent.Range(prev - 1, p.Previous.Range.End).HighlightColorIndex = IIf(b, 3, 7)
141                   End If
151                   b = Not b
161                   prev = p.Range.Start + 1
171               End If
181           Next
191       End With
201       Application.ScreenUpdating = 1
211       On Error GoTo 0
221       Exit Sub
colorize_Error:
231       MsgBox "Error " & Err.Number & " (" & Err.Description & _
              ") in procedure colorize of VBA Document ThisDocument on line " & Erl & vbLf & _
              "paragraphs.count: " & Paragraphs.Count & ",  current paragraph: " & Range(0, _
              p.Range.End).Paragraphs.Count
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 05.08.2019 в 18:53
krosav4ig Дата: Воскресенье, 04.08.2019, 19:03 | Сообщение № 219 | Тема: вернуть значение без нуля стоящего впереди
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Если вдруг фиг знает сколько значные номера появятся
Код
=--СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(ПОДСТАВИТЬ(A3;B3&"№";)," ";"         ");1;9))

[p.s.] писал с андроида, если вдруг чего, эт не я, эт телефон накосячил :)
К сообщению приложен файл: 1082584.xlsx (7.7 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЕсли вдруг фиг знает сколько значные номера появятся
Код
=--СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(ПОДСТАВИТЬ(A3;B3&"№";)," ";"         ");1;9))

[p.s.] писал с андроида, если вдруг чего, эт не я, эт телефон накосячил :)

Автор - krosav4ig
Дата добавления - 04.08.2019 в 19:03
krosav4ig Дата: Воскресенье, 04.08.2019, 12:00 | Сообщение № 220 | Тема: Вставить значение одной ячейки в текст второй
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте
[vba]
Код
=ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;СИМВОЛ(13);); "</p><p>Если Вам";"</p>"&A2&"<p>Если Вам")
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Воскресенье, 04.08.2019, 12:04
 
Ответить
СообщениеЗдравствуйте
[vba]
Код
=ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;СИМВОЛ(13);); "</p><p>Если Вам";"</p>"&A2&"<p>Если Вам")
[/vba]

Автор - krosav4ig
Дата добавления - 04.08.2019 в 12:00
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!