Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 282 След.
Как скрыть неиспользуемые ячейки
 
Цитата
Trimsurface написал:
как сделать файл более компактным и например вообще убрать ячейку "Количество слов" напишите пожалуйста
UDF, пример в яч. М1
Код
Function Tr(txt, ShirBukv, Interval, ShirProbel) As Long
Dim x
  For Each x In Split(txt)
    Tr = Tr + Len(x) * ShirBukv + ShirProbel
    If Len(x) > 1 Then Tr = Tr + (Len(x) - 1) * Interval
  Next
  Tr = Tr - ShirProbel
End Function
Цитата
Trimsurface написал:
как допустим если есть буква "М" то ширина букв будет не "4" а "5"?
Нужен список широких букв и их ширина как еще два параметра функции.
Возможно ли суммирование ячеек, содержащих SUMM () или СУММ()?
 
Цитата
Les555 написал:
Есть данные в столбце, переодически данные суммируются через Summ(диапазон).
Используйте функцию ПРОМЕЖУТОЧНЫЕ.ИТОГИ. В стиле R1C1 во всех ячейках с суммой будет одна и та же формула
Код
=ПРОМЕЖУТОЧНЫЕ.ИТОГИ(9;R8C:R[-1]C)
Изменено: Казанский - 8 Дек 2018 14:43:35
Как исправить ошибку "Type mismatch"?
 
кросс http://www.cyberforum.ru/visual-basic/thread2367089.html
VBA. Помогите найти количество значений в диапазоне в сравнении с 0.
 
https://www.sql.ru/forum/932580/posobie-dlya-studentov-i-shkolnikov
Ограничение длины числа. Почему в текстовой записи числа воспринимается разное количество символов?
 
kazsatter, похоже автозаполнение работает в пределах 2^32=4294967296

E:\bqotbasy\4294967293
E:\bqotbasy\4294967294
E:\bqotbasy\4294967295
E:\bqotbasy\0
E:\bqotbasy\1
E:\bqotbasy\2

vikttur, а что не так? Ведущие нули же не являются значащими цифрами.
Изменено: Казанский - 29 Ноя 2018 03:35:40
Смещение времени (минуты)
 
или
Код
=ТДАТА()-"0:34"
Сравнение каждой строки одного диапазона с другим
 
Код
Sub Макрос1()
Dim x, i&
  i = 2
  Rows(1).Insert
  For Each x In Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
    Columns(2).AutoFilter Field:=1, Criteria1:="=*" & x & "*"
    i = i + 1
    ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Cells(1, i)
  Next
  Rows(1).Delete
End Sub
Перенос оформления текста ячеек диапазона ссылкой
 
memo, в смысле - редактируемый? При изменении ячеек на первом листе их изображение на втором листе тоже меняется. На то она и СВЯЗЬ с рисунком.
Перенос оформления текста ячеек диапазона ссылкой
 
memo, связь с рисунком. Если установить одинаковый размер строк и ширину столбца на обоих листах, будет хорошо.
Перенос оформления текста ячеек диапазона ссылкой
 
Цитата
memo написал:
В архиве нашел тему "Перенос форматирования ячейки ссылкой", но это немного не то, что нужно
Дали бы ссылку, что ли, искать лень.
Там рассматривался способ "вставить связь с рисунком"?
Как автоматически подобрать значение в каждой строке таблицы для получения требуемого результата?, Нужен простейший цикл
 
Цитата
dragondv написал:
Qвдхр нужно подобрать число... чтобы выполнилось условие Nгэс = Nраб
В какой-нибудь ячейке, например О7 =O5-P5
Данные - Анализ что-если - Подбор параметра: установить в ячейке О7 значение 0 изменяя значение ячейки Е5 - ОК.
Копирование текста из txt невзирая на ограничитель
 
Шурик Владимирский, так попробуйте
Код
Sub readtxt()
    Dim FileNameTxt$: FileNameTxt = "D:\12\1.txt"
    Dim meData$(), i&, sStr$, LastRow&
    Dim filenum&: filenum = FreeFile()
    
    LastRow = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row

    Open FileNameTxt For Input As #filenum
    sStr = Input(LOF(filenum), filenum)
    Close #filenum
    i = InStrRev(sStr, "РАЗДЕЛИТЕЛЬ ТЕКСТА")
    If i Then
      i = InStr(i, sStr, vbLf)
      If i Then
        meData = Split(Mid$(sStr, i + 1), vbCrLf)
        If UBound(meData) >= 0 Then
          Cells(LastRow + 1, 6).Resize(UBound(meData) + 1).Value = Application.Transpose(meData)
        End If
      End If
    End If

End Sub
Как закрасить 10 ячеек влево от ячейки со значением 24
 
artyrH,
Каждую десятую долю секунды в отдельную строку
 
Ну раз название темы предложено, мой вариант. В А1 превратить текстовое представление даты в числовое, заменив точку на запятую. Формат столбца ДД.ММ.ГГГГ ч:мм:сс,0"00000"
Для заполнения использовать инструмент Прогрессия, скрин диалогового окна с параметрами в файле.
VBA Ошибка 13 Type Mismatch Где ошибка в коде?, Ошибка 13 Type Mismatch в цикле пер
 
professor19810826, тем, что rr.Value = Error 2042, т.е. #Н/Д. Значения ошибки нельзя сравнивать с числами.
Введите проверку If not iserror(rr.Value) ...
Распределение данных в соответствии со столбцом-эталоном
 
scorzy, пробуйте
Код
Sub Sc()
Dim i&
  i = 3 'первая строка
  Application.ScreenUpdating = False
  Do
    If Cells(i, 2) <> "" And Cells(i, 3) <> "" Then
      Select Case Cells(i, 2) - Cells(i, 3)
      Case Is < 0 'B<C
        Cells(i, 3).Resize(, 2).Insert xlShiftDown
      Case Is > 0
        Cells(i, 2).Insert xlShiftDown
      End Select
    End If
    i = i + 1
  Loop Until Cells(i, 2) = "" And Cells(i, 3) = ""
  Application.ScreenUpdating = True
End Sub
Протягивание формул с помощью макроса
 
Цитата
serega1705 написал:
формула изменяется, первый аргумент перескакивает через одну ячейку
Да, странный эффект, похоже на баг в Excel.
Можно копировать существующие формулы, так даже проще
Код
Sub Se1()
Dim a As Range
  For Each a In Range("A:A").SpecialCells(xlCellTypeBlanks).Areas
    a.Cells(0, 1).Resize(, 5).Copy a
  Next
End Sub
Изменить начало отсчета массива с 0 на 1
 
Цитата
Jack Famous написал:
Split всегда возвращает массив с 0
Да. А вот Array может всегда возвращать массив с 0, а может учитывать Option Base!
Код
Option Base 1

Sub test()
Dim a(), b$()
  a = Array(1, 2, 3)
  Debug.Print LBound(a), UBound(a) '1 3
  a = VBA.Array(1, 2, 3)
  Debug.Print LBound(a), UBound(a) '0 2
  b = Split("a b c")
  Debug.Print LBound(a), UBound(a) '0 2
  b = VBA.Split("a b c")
  Debug.Print LBound(a), UBound(a) '0 2
End Sub
Изменено: Казанский - 22 Ноя 2018 12:14:39
Протягивание формул с помощью макроса
 
serega1705, а, значит формулы в строках ниже констант существуют? Тогда проще их убрать и вставить как в #2
Код
Sub Se()
Dim a As Range, n&
  Range("A:E").SpecialCells(xlCellTypeFormulas).ClearContents
  For Each a In Range("A:E").SpecialCells(xlCellTypeBlanks).Areas
    n = a.Row - 1
    a.FormulaR1C1 = Array("=R[-1]C+R" & n & "C3", "=R[-1]C+R" & n & "C4", "", "", "=R[-1]C+R" & n & "C6")
  Next
End Sub
Вспомогательно выделение строки при наборе текста, Раздражает выделение строки при на наборе текста, не знаю как убрать
 
giveuper, не подключена ли надстройка, которая делает что-то вроде этого: https://www.planetaexcel.ru/techniques/3/58/
Найти минимальное расстояние между точками
 
Teklan, переписываю данные из исходного двумерного массива (значение диапазона, тип Variant) в два одномерных типа Double. Чтобы потом находить разности было удобнее и быстрее.
Пройдите этот цикл по шагам: точку останова на 14 строку, обновить функцию - она будет вызвана и произойдет останов, далее F8 и смотрите содержимое переменных в Locals.
Найти минимальное расстояние между точками
 
Teklan, вот что получилось. Функция возвращает массив из 5 чисел. Для визуализации добавил условное форматирование. На втором листе заполнил часть диапазона функцией СЛЧИС. При пересчете по F9 основное время занимает пересчет УФ.
Код
Function Te(data As Range) As Variant()
Dim r&, c&, i&, j&, im&, jm&, d#, dm#, v(), x#(), y#()
  v = data.Value2
'определение границ массива по первому столбцу и первой строке
  For r = UBound(v) To 1 Step -2
    If v(r, 1) <> 0 Then Exit For
  Next
  r = r \ 2
  For c = UBound(v, 2) To 1 Step -1
    If v(1, c) <> 0 Then Exit For
  Next
'данные - в одномерные массивы
  ReDim x(1 To r * c), y(1 To r * c)
  For i = 1 To c
    For j = 1 To r
      im = im + 1
      x(im) = v(j * 2 - 1, i): y(im) = v(j * 2, i)
    Next
  Next
'нахождение мин
  dm = 1E+99
  For i = 1 To r * c - 1
    If x(i) <> 0 And y(i) <> 0 Then
      For j = i + 1 To r * c
        If x(j) <> 0 And y(j) <> 0 Then
          d = (x(j) - x(i)) ^ 2 + (y(j) - y(i)) ^ 2
          If d < dm Then dm = d: im = i: jm = j
        End If
      Next
    End If
  Next
  Te = Array(Sqr(dm), x(im), x(jm), y(im), y(jm))
End Function
Изменить начало отсчета массива с 0 на 1
 
venrt, Если именно As String() и именно через Split, то штатными средствами - никак.
Можно поставить впереди текста пробел и получить массив с нижним индексом 0, но с полезными данными, начинающимися с 1
Код
P = " P20 P44 P64 P83"
arrP = Split(P)
Можно разбить строку во временный массив и переписать в основной с нужным нижним индексом.
Можно получить массив типа Variant/String так
Код
Option Base 1
'...
Dim arrP()
arrP = Array("P20", "P44", "P64", "P83")
Или нештатными средствами - с помощью RtlMoveMemory изменить нижний индекс в структуре SAFEARRAY.
Изменено: Казанский - 21 Ноя 2018 16:39:30
Протягивание формул с помощью макроса
 
serega1705, если изначально области между строками пустые
Код
Sub Se()
Dim a As Range, n&
  For Each a In Range("A:E").SpecialCells(xlCellTypeBlanks).Areas
    n = a.Row - 1
    a.FormulaR1C1 = Array("=R[-1]C+R" & n & "C3", "=R[-1]C+R" & n & "C4", "", "", "=R[-1]C+R" & n & "C6")
  Next
End Sub
Изменено: Казанский - 21 Ноя 2018 15:41:35
Помогите отсечь конечные нули ном.номера
 
Цитата
vikttur написал:
Эта учитывает и много левых нулей
о да!
Код
=ПСТР(-(","&A1);4;99)
Помогите отсечь конечные нули ном.номера
 
vikttur, формулист однако  8)
Правда если впереди два нуля будет или число значащих цифр, без последних нулей, больше 15...
Помогите отсечь конечные нули ном.номера
 
Код
=ЛЕВБ(A1;ПРОСМОТР(2;1/ПСТР(A1;СТРОКА($1:$99);1);СТРОКА($1:$99)))
изменить язык интерфейса VBA
 
Цитата
alexandrkudryavcev написал:
в интерфейсе VBA
Tools - Options - Editor format - Font, лучше Courier New (Кириллический)
Скрытие/Открытие текущей книги
 
Application замените на ThisWorkbook.Windows(1)
Ссылка на переменную из другой книги
 
Андрей VG, да, действительно.
В какую папку распаковывать - безразлично. Я просто открыл оба файла из окна WinRAR, файлы были распакованы в разные папки, все работает.
Цитата
Андрей VG написал:
ни кто и ни что не запрещает раннего?
В данном случае это неизвестно, ТС не представила задания.
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 282 След.
Наверх