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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 289 След.
Одной формулой определить идут ли даты в диапазоне по порядку
 
Konstantin Zhi, возможно неоптимально, формула массива
Код
=И(СМЕЩ(Таблица1[Дата];;;СЧЁТ(Таблица1[Дата])-1)<=СМЕЩ(Таблица1[Дата];1;;СЧЁТ(Таблица1[Дата])-1))
Одной формулой определить идут ли даты в диапазоне по порядку
 
Konstantin Zhi, формула массива
Код
=И(A4:A38<=A5:A39)
Собрать информацию из нескольких файлов CSV в один., макрос
 
Цитата
artyrH написал:
utf-8 - это проблема?
Однако да! Погуглите cmd utf-8 - увидите. Вот vbs, который соединяет файлы, дописывает имя файла, удаляет заголовки (кроме первого). Сохраните в папку с файлами и запускайте.
Код
Option Explicit

Const OUTFILE = "Общий.csv"
Dim objStreamIn, objStreamOut, strData, blnSecond, lngI, objFile, strBaseName, strFldr
  Set objStreamIn = CreateObject("ADODB.Stream")
  objStreamIn.Charset = "utf-8"
  Set objStreamOut = CreateObject("ADODB.Stream")
  objStreamOut.Charset = "utf-8"
  objStreamOut.Open
  With CreateObject("scripting.filesystemobject")
    strFldr = .getfile(wscript.scriptfullname).parentfolder.Path & "\"
    For Each objFile In .getfolder(strFldr).Files
      If StrComp(OUTFILE, objFile.Name) <> 0 And StrComp(".csv", Right(objFile.Name, 4)) = 0 Then
        objStreamIn.Open
        objStreamIn.LoadFromFile objFile.Path
        strData = objStreamIn.ReadText
        objStreamIn.Close
        strBaseName = Left(objFile.Name, Len(objFile.Name) - 4)
        For lngI = Len(strData) To 1 Step -1
          If Asc(Mid(strData, lngI, 1)) > 13 Then strData = Left(strData, lngI): Exit For
        Next
        If blnSecond Then
          strData = Mid(strData, InStr(strData, vbLf))
          objStreamOut.WriteText Replace(strData, vbLf, vbLf & """" & strBaseName & """,")
        Else
          objStreamOut.WriteText """Файл""," & Replace(strData, vbLf, vbLf & """" & strBaseName & """,")
          blnSecond = True
        End If
      End If
    Next
  End With
  objStreamOut.WriteText vbLf
  objStreamOut.SaveToFile strFldr & OUTFILE, 2
удаление листов из книги вне списка/столбца значений макрос
 
Tesla_LOLa, c использованием ПОИСКПОЗ
Код
Sub DelSheets()
Dim sh As Object
  Application.DisplayAlerts = False
  For Each sh In Sheets
    If IsError(Application.Match(sh.Name, Worksheets("check").Columns(7), 0)) Then sh.Delete
  Next
  Application.DisplayAlerts = True
End Sub
Изменено: Казанский - 20 Фев 2019 00:07:17
Найти ячейки с содержанием нужного слова и поменять в них полностью текст
 
artyrH,
Код
Sub Ar()
Dim v(), i&
  v = Range("M:N").SpecialCells(xlCellTypeConstants).Value
  For i = 1 To UBound(v)
    Range("A:J").Replace v(i, 1), v(i, 2), xlWhole, SearchFormat:=False, ReplaceFormat:=False
  Next
End Sub
Собрать информацию из нескольких файлов CSV в один., макрос
 
Цитата
artyrH написал:
правильный результат только у однострочного бата от  Hugo
Кто ж знал, что ваши csv в кодировке UTF-8  :sceptic:
Сгенерировать случайные неповторяющиеся числа
 
said.makhmudov,
Код
Sub Randomnumber()
'  Randomize
  With Range("D11").Resize(Range("B13").Value, 1)
    .Formula = "=RAND()"
    .Value = Evaluate(Replace("INDEX(RANK(@,@),)", "@", .Address(, , Application.ReferenceStyle)))
  End With
End Sub
Как добавить к содержимому ячейки пробелы, нужно из excel получить содержимое ячеек в текстовый файл с фиксированым количеством символов
 
Или так - короче, менее очевидна ширина каждой колонки, но более наглядна начальная позиция каждой колонки
Код
Sub Al_1()
Dim v(), i&
  Open ActiveWorkbook.Path & "\ok.txt" For Output As #1
  v = Range("A1", Cells(Rows.Count, "F").End(xlUp)).Value
  For i = 1 To UBound(v)
    Print #1, Format$(v(i, 1), "@@@@"); v(i, 2); Tab(25); v(1, 3); _
      Tab(50); v(1, 4); Tab(70); v(1, 5); Tab(95); v(1, 6); Tab(135)
  Next
  Reset
End Sub
Как добавить к содержимому ячейки пробелы, нужно из excel получить содержимое ячеек в текстовый файл с фиксированым количеством символов
 
alexbuh, вот таким макросом можно сохранить содержимое текущего листа в файл "ok.txt" в папку с книгой
Код
Type Fixed
  a As String * 4
  b As String * 20
  c As String * 25
  d As String * 20
  e As String * 25
  f As String * 40
  g As String * 2
End Type

Sub Al()
Dim v(), i&, f$, t As Fixed
  Open ActiveWorkbook.Path & "\ok.txt" For Random As #1 Len = Len(t)
  v = Range("A1", Cells(Rows.Count, "F").End(xlUp)).Value
  t.g = vbCrLf
  For i = 1 To UBound(v)
    RSet t.a = v(i, 1)
    LSet t.b = v(i, 2)
    LSet t.c = v(i, 3)
    LSet t.d = v(i, 4)
    LSet t.e = v(i, 5)
    LSet t.f = v(i, 6)
    Put 1, , t
  Next
  Reset
End Sub
Изменено: Казанский - 18 Фев 2019 00:29:28
Собрать информацию из нескольких файлов CSV в один., макрос
 
artyrH, чуть изменить бат БМВ
Код
echo off 
rem // переходим в папку .если нужно то можно указывать путь или сейчас в текущем собирает
rem cd /D %_mainpath%  
 
del Common.csv
 
rem // цикл по всем файлам  c раширение .csv в папке и стыкуем их в Common.tmp
for  %%f in (*.csv) do (
   rem // строки из очередного файла с добавлением имени через ;
   for /f %%s in (%%f) do echo %%~nf;%%s >> Common.tmp
)
rem // переименовываем выходной файл
ren Common.tmp common.csv
Изменено: Казанский - 17 Фев 2019 23:55:22
Как протянуть формулу массива VBA
 
Hashtag, удобно использовать .FillDown , свежий пример: http://www.cyberforum.ru/vba/thread2405190.html#post13333781
Найти ячейки с содержанием нужного слова и поменять в них полностью текст
 
kooller21, чем обычный поиск-замена не устраивает? Флажок "Ячейка целиком" должен быть очищен.
Поиск в диапазоне наибольшего значения суммы из последовательных отрицательных значений
 
Sayberix, может UDF удобнее будет, она вводится в две ячейки как формула массива. Можно передавать целые столбцы: =sa(A:B)
Код
Function Sa(r As Range)
Dim v(), i&, n&, s#, sm#, nm&
  v = Intersect(r, r.Worksheet.UsedRange).Value2
  For i = 1 To UBound(v)
    If v(i, 2) < 0 Then
      If n Then s = s + v(i, 2) Else n = i: s = v(i, 2)
    Else
      If s < sm Then sm = s: nm = v(n, 1)
      n = 0
    End If
  Next
  If s < sm Then sm = s: nm = v(n, 1)
  Sa = WorksheetFunction.Transpose(Array(sm, nm))
End Function
В принципе, в функцию и закрашивание ячеек можно добавить, но кода в несколько раз больше станет. Закрашивание можно сделать условным форматированием.
Изменено: Казанский - 16 Фев 2019 21:32:18
Форматирование символов текста в зависимости от их цвета
 
Как вариант, перенести в Word, сделать замену с форматом, перенести обратно.
Вывод только согласных из ячейки.
 
Александр Моторин, что с буквами "ь", "ъ", цифрами, другими знаками?
Код
Function ТолькоСогл$(s$)
Static re As Object
  If re Is Nothing Then
    Set re = CreateObject("vbscript.regexp")
    re.Pattern = "[^бвгджзйклмнпрстфхцчшщ]+"
    re.Global = True
    re.ignorecase = True
  End If
  ТолькоСогл = re.Replace(s, vbNullString)
End Function
Изменено: Казанский - 16 Фев 2019 14:07:54
копирование только текста ячейки в буфер
 
Копируйте не Ctrl+c, а F2 - Ctrl+Shift+Home - Ctrl+c - Esc. Или макросом - поищите на форуме DataObject или {1C3B4210-F441-11CE-B9EA-00AA006B1A69}
Макрос для группировки
 
andronus,
Код
Sub An()
Dim v(), i&, j&
  v = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
  For i = 2 To UBound(v)
    If IsDate(v(i, 1)) Then
      If j > 0 And i - j > 1 Then Range(Rows(j + 1), Rows(i - 1)).Group
      j = i
    End If
  Next
  If j > 0 And i - j > 1 Then Range(Rows(j + 1), Rows(i - 1)).Group
End Sub
А Вам правда удобно иметь даты в виде текста? Превратить даты в числовые значения легко: выделить столбец А, Ctrl+h, заменить точку на точку.
Передать двумерный массив Variant из VBA в dll C++, ...и вернуть их после обработки обратно в VBA.
 
Роман3101, можно объявить As Variant, тогда можно передавать что угодно, за исключением пользовательских типов.
Тогда задача dll - разобраться в структуре переданного Variant.
https://rsdn.org/article/com/varsafearr.xml
Определение коэффициентов тренда в программе
 
tutochkin,
https://www.planetaexcel.ru/forum/?PAGE_NAME=read&FID=1&TID=48049
еще https://www.google.com/search?q=worksheetfunction.linest+site%3Aplanetaexcel.ru

То есть у Вас два пути. Если массивы короткие, как в примере, можно перевести их в текстовый вид и использовать Evaluate, например для parametr=1 получится
Код
arrResult = Evaluate("LINEST({5;6;7;8},{100;100;100;100}^{1,2,3})")

Либо использовать Worksheetfunction.Linest как нормальную функцию VBA, тогда придется сформировать двумерный массив для второго аргумента в коде.
Еще - Linest возвращает массив, см. Справку. Не надо вызывать ее несколько раз с теми же аргументами. Вызовите один раз и извлеките из массива нужные элементы.
Как перенести ссылки по столбцу без изменения адреса.
 
Tein, сделать столбец абсолютным?
Код
='B:\Аналитический отдел\Аналитика продаж\Obmen\1. ОА\2019\Фактирование мороженое\[Конвертор для фактирования МОРОЖЕНОГО декаб 18 проб.xlsb]4. разноска'!$E36
Объединить файлы с определенной частью названия файла
 
Цитата
eeigor написал:
В VBA есть штатная функция Filter(), но она не работает с маской
В данном случае как раз
Код
?join(filter(array("магазин одежды","гастроном","фирменный магазин"),"МАГАЗИН",,vbTextCompare),",")
магазин одежды,фирменный магазин
Изменено: Казанский - 12 Фев 2019 16:44:11
Макрос рандомного перехода
 
По мотивам Sceptic
Код
Sub Go()
 
  [INDEX(A:A,2+RAND()*COUNTA(A:A))].select
 
End Sub
Разное форматирование текста при записи в одну ячейку из нескольких других.
 
кросс http://www.cyberforum.ru/vba/thread2402356.html
TRIM CLEAN для VBA
 
Цитата
vikttur написал:
В чем разница?
Application.Trim работает с массивом.
(Application.)WorksheetFunction.Trim и (VBA.)Trim не работают с массивом - надо писать циклы.
Как обратиться к диапазону Умной таблицы?
 
Цитата
KonstantinK написал:
Данный код будет обрабатывать первую строку - шапку и последнюю - итоги
Не будет. Сходите по ссылке, которую я дал - там на рисунках показано, что такое .Range, .DataBodyRange и другие части таблицы.
Как обратиться к диапазону Умной таблицы?
 
KonstantinK, https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables
Запуск музыкального файла при нажатии кнопки
 
kletskova, https://www.planetaexcel.ru/forum/?PAGE_NAME=read&FID=8&TID=42956
Еще https://www.google.com/search?q=mp3+site%3Aplanetaexcel.ru
TRIM CLEAN для VBA
 
Код
Sub Test_1()
  With Intersect(Range("A:F"), ActiveSheet.UsedRange)
    .Value = Application.Trim(.Value)
  End With
End Sub
Как подтянуть данные из другой книги не открывая ее?
 
Cappuccino, не пробовали погуглить по названию темы? Например https://www.excel-vba.ru/chto-umeet-excel/kak-poluchit-dannye-iz-zakrytoj-knigi/
Совместное использование методов .find и .findnext
 
Цитата
tsutse написал:
1. Макрос в первом проходе находит наибольшее количество символов в каждой ячейке.
Это можно сделать проще
Код
STRlenMAX = [MAX(LEN(TAB_3))]
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 289 След.
Наверх