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

Страницы: 1 2 3 След.
Подсчитать количество уникальных значений в диапазоне.
 
Мне кажется проще вот такой формулой: =СУММПРОИЗВ(1/СЧЁТЕСЛИ(A2:A100000;A2:A100000&""))-1
По времени отрабатывает быстро.
Изменено: Ametist69 - 8 Ноя 2019 12:17:16
Ограничение динамического выпадающего списка по категории
 
По моему можно как-то даже без макроса сделать зависимый выпадающий список.
Пример моих набросков (не доделал) прикладываю.
Нахождение уникальной строки с четырьмя уникальными ячейками и удалением повторяющихся
 
Taimu, Не совсем понимаю, почему нужно чистить стоки, а не удалять.
Но если именно так как вы хотите, то вот код:
Код
Sub Test()

Dim AC&
AC = Application.Calculation
Application.Calculation = xlCalculationManual

NameBook = ThisWorkbook.Name

RowsCount = Workbooks(NameBook).Worksheets("Лист1").Cells(Rows.Count, 2).End(xlUp).Row

For x = RowsCount To 2 Step -1
    If Cells(x, 2).Value = "" Then
    Cells(x, 2).Select
    Else
        For y = 2 To 5
        Number = Cells(x, y).Value
            For a = x - 1 To 2 Step -1
                If Cells(a, 2) = Number Or Cells(a, 3) = Number Or Cells(a, 4) = Number Or Cells(a, 5) = Number Then
                Range(Cells(a, 2), Cells(a, 5)).Clear
                End If
                RowsCount = Workbooks(NameBook).Worksheets("Лист1").Cells(Rows.Count, 2).End(xlUp).Row
            Next
        Next
    End If
Next

Application.Calculation = AC
            
End Sub
Нахождение уникальной строки с четырьмя уникальными ячейками и удалением повторяющихся
 
Если задача стоит с проверкой по строкам тоже, как описал 2 вариант, то можно сделать вот так (только формулы вставьте как значения перед запуском макроса, а то долго будет отрабатывать, т.к. формулы будут пересчитываться при удалении каждой строки):
Код
Sub Test()

NameBook = ThisWorkbook.Name

RowsCount = Workbooks(NameBook).Worksheets("Лист1").Cells(Rows.Count, 2).End(xlUp).Row

For x = 2 To RowsCount
    For y = 2 To 5
    Number = Cells(x, y).Value
        For a = x + 1 To RowsCount
            If Cells(a, 2) = Number Or Cells(a, 3) = Number Or Cells(a, 4) = Number Or Cells(a, 5) = Number Then
            Rows(a).Delete
            a = a - 1
            End If
            RowsCount = Workbooks(NameBook).Worksheets("Лист1").Cells(Rows.Count, 2).End(xlUp).Row
        Next
    Next
Next
            

End Sub

Изменено: Ametist69 - 22 Окт 2019 17:47:00
Нахождение уникальной строки с четырьмя уникальными ячейками и удалением повторяющихся
 
Не совсем понятна задача, если в строке все 4 цифры уникальные то оставляем строку, а если не все 4 уникальные, то удаляем?
Верно?
Или проверку по строкам тоже делать? и если например в строке 1 все цифры уникальные, и в строке 2 все уникальные, но в строке 2 одна цифра есть и в строке 1, то строку 2 удаляем?
Изменено: Ametist69 - 22 Окт 2019 16:46:47
При замене данных на выделенных листах замены происходят только на первом и последнем листе
 
Цитата
Dark1589 написал:
А на активном листе выделена одна ячейка? Или диапазон?
Да, на активном листе выделена одна ячейка. Листы выделять пробовал как через Ctrl, так и через Shift.
Вопрос в том что во всей то книге можно заменить, через доп.параметры замены. А если нужно именно в определённых, то не меняет только на первом и последнем (из выделенных).
Версия Excel 2016 Professional
Изменено: Ametist69 - 22 Окт 2019 16:21:10
При замене данных на выделенных листах замены происходят только на первом и последнем листе
 
Цитата
Kentavrik7 написал:
Проделываю тоже самое, замены происходят на первом и на последнем выделенном листе. И хоть ты тресни.
Странно)) действительно только с заменой такая  ерунда... Со всеми другими действиями работает...
подсчет количества счетов по датам и оплаченным за месяц и год
 
=СЧЁТЕСЛИМН(диапазон1; условие1; диапазон2; условие2; ....... и т.д.)

Просто количество диапазонов должно совпадать с количеством условий. Почитайте описание формулы, в Гугле все это есть.
Excel вылетает при сохранении файла, Excel вылетает при сохранении файла либо при запуске макроса
 
Так может в макросе прописано условие для выхода из файла
Если не можете файл приложить, то скопируйте сюда код макроса, только оформите в виде кода.
Изменено: Ametist69 - 2 Окт 2019 16:49:18
Изменение процента после окупаемости
 
kanat.khairov, Пример скиньте что должно получиться.
Иморт содержания текстовых файлов в соответсвующие ячейки таблицы, Иморт содержания текстовых файлов в соответсвующие ячейки таблицы
 
Ну вот по быстрому макрос накидал, можете попробовать под себя его переделать.
Но это случай, если файлы лежат в одной директории:
Код
Sub Test()

Dim objFileSys As Object, sS As String
Dim NameCity As String

LastCell = Workbooks("Тест.xlsx").Worksheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row

For x = 2 To LastCell

NameCity = Cells(x, 1).Value

Set objFileSys = CreateObject("Scripting.FileSystemObject")
sS = objFileSys.OpenTextFile("C:\Users\Test\Desktop\Тест\" & NameCity & ".txt", Format:=-2).ReadAll

Cells(x, 2).Value = sS

Next

End Sub
Изменено: Ametist69 - 12 Сен 2019 13:48:01
Иморт содержания текстовых файлов в соответсвующие ячейки таблицы, Иморт содержания текстовых файлов в соответсвующие ячейки таблицы
 
почитайте вот эту тему: https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=102627&TITLE_SEO=102627-peredacha-v-peremennuyu-soderzhimogo-tekstovogo-fayla-sredstvami-vba&buf_fid=5
Макрос автоматической отправки писем при открытии книги
 
Ну у меня на код написан на листе "эта книга", и корректно отрабатывает. Попробуйте туда прописать.
А далее через функцию Call запускать другие макросы поочерёдно.
Изменено: Ametist69 - 10 Сен 2019 11:06:06
Разбивка числа кратно 50
 
Файл с примером приложите пожалуйста.
В котором наглядно будет видно что должно получиться.
Изменено: Ametist69 - 10 Сен 2019 10:57:37
Убрать невидимый знак переноса. Волшебство какое-то
 
Цитата
BobbyJo написал:
ожалуйста внимательней скриншоты и файл-пример. Через ctrl+J пропадут как раз нормальные переносы. А тут перенос, который вообще в экселе не виден и таким образом никуда не денется
Можно попробовать через формулу =ПЕЧСИМВ. Я по моему так убирал.
Подстановка даты и времени в зависимости от условия, Подстановка даты и времени в зависимости от условия
 
Цитата
buchlotnik: можно же просто формулой:
Спасибо, буду знать что можно и такого формата формулой) Но мне было быстрее макрос написать)
Полезная инфа, спасибо!
Подстановка даты и времени в зависимости от условия, Подстановка даты и времени в зависимости от условия
 
На всякий случай, если кому-то понадобится решил эту задачу макросом, при этом во второй столбец просто вытащил номер часа, и на него и ориентировал код:

Код
Sub test()

Dim Data1 As Date

NameBook = ThisWorkbook.Name

LastCell = Workbooks(NameBook).Worksheets("Лист (1)").Cells(Rows.Count, 3).End(xlUp).Row

For x = 2 To LastCell

If Cells(x, 2) > 20 Then
Data1 = (Left(Cells(x, 4).Value, 2) + 1) & Mid(Cells(984, 4).Value, 3, 8) & " 09:00"
Cells(x, 1).Value = Data1
ElseIf Cells(x, 2) < 9 Then
Data1 = Left(Cells(x, 4).Value, 10) & " 09:00"
Cells(x, 1).Value = Data1
Else
Cells(x, 1).Value = Cells(x, 3).Value
End If

Next

End Sub
Подстановка даты и времени в зависимости от условия, Подстановка даты и времени в зависимости от условия
 
Всем добрый день!

Помогите пожалуйста решить задачу. В столбце есть данные по дате и времени события.
Как сделать так, чтобы если время события было в период с 21:00 по 00:00, то в соседней ячейке подставится дата следующего дня 09:00 часов утра.
Если же в период с 00:00 до 09:00, то подставится этот же день но время 09:00.
Если период времени с 09 утра до 21 часа, то остаются фактические дата и время.

Файл как должно получиться во вложении.

P.S.: Модераторы сообщите, пожалуйста, если название не раскрывает тему, но вроде доходчиво написал.
Подключение к MySQL из VBA
 
Проблема решилась, большое спасибо!
Если кому пригодится, вот рабочий код:
Код
Sub Подключение()

Dim cnnConnect As ADODB.Connection
Dim rstRecordset As ADODB.Recordset

Application.ScreenUpdating = False
Application.EnableEvents = False
Set cnnConnect = New ADODB.Connection
Set rstRecordset = New ADODB.Recordset
cnnConnect.Open "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=localhost;DATABASE=my_db;UID=user_test;PASSWORD=123456;PORT:3306;"
rstRecordset.Open Source:="SELECT * FROM my_table", ActiveConnection:=cnnConnect, CursorType:=adOpenDynamic, LockType:=adLockReadOnly, Options:=adCmdText
With Sheets(1).QueryTables.Add( _
        Connection:=rstRecordset, _
        Destination:=Sheets(1).Range("A1"))
        .Name = "Test_request"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = True
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
End With
rstRecordset.Close
cnnConnect.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Подключение к MySQL из VBA
 
Добрый день!

Столкнулся с той же проблемой, только ошибка другая:


Код выглядит вот таким образом
Код
Dim conn As Object
Set conn = New ADODB.Connection
conn.ConnectionString = "DRIVER={MySQL ODBC 8.0 ANSI Driver};SERVER=localhost;PORT:3307;DATABASE=my_db;UID=user_test;Pwd=12345;Option=3;"
conn.Open
Пишет что доступ пользователю запрещён, хотя в настройках самой БД пользователю user_test доступ предоставлен.
Разрядность системы, офиса и драйвера совпадает. Необходимая библиотека подключена.

Помогите пожалуйста разобраться.
Изменено: Ametist69 - 28 Июн 2019 11:26:53
Фильтры сводной таблицы VBA, Фильтры сводной таблицы VBA
 
Андрей спасибо, а можете подсказать как правильно написать для очистки этих фильтров?

PivotTable(1).RowFields.Clear не подходит.

Гугл пока че-то тоже не подсказывает((
Изменено: Ametist69 - 31 Май 2019 13:29:29
Фильтры сводной таблицы VBA, Фильтры сводной таблицы VBA
 
Всем добрый день!
Подскажите пожалуйста, при работе со сводными таблицами через VBA можно ли как либо разделить фильтры из полей строк и столбцов, и общий фильтр сводной таблицы?
То есть есть код:
Код
Sub Pivot()

ThisWorkbook.RefreshAll
Dim ws As Excel.Worksheet
Dim pvt As Excel.PivotTable
Dim pvi As PivotItem

For Each ws In ActiveWorkbook.Worksheets
    For Each pvt In ws.PivotTables
        pvt.ClearAllFilters
        For Each pvf In pvt.PivotFields
        On Error Resume Next
        pvf.PivotItems("(blank)").Visible = False
        pvf.PivotItems("").Visible = False
        Next pvf
    Next pvt
Next ws

End Sub
В данном коде строкой pvt.ClearAllFilters я очищаю все фильтры, а хотелось бы очищать только фильтры столбцов и строк.
Более понятно думаю на картинке (во вложении)
Изменено: Ametist69 - 31 Май 2019 13:11:37
Не удается скопировать лист, Не удается скопировать лист
 
Добрый день!
Вы можете приложить сам файл, в котором возникает ошибка?
если дата приходится на выходной день, то отображается первый рабочий день.
 
Я бы сделал так:
Код
=ЕСЛИ(ДЕНЬНЕД(ДАТА(ГОД(A2);МЕСЯЦ(A2)+1;5))=7;ДАТА(ГОД(A2);МЕСЯЦ(A2)+1;7);ЕСЛИ(ДЕНЬНЕД(ДАТА(ГОД(A2);МЕСЯЦ(A2)+1;5))=1;ДАТА(ГОД(A2);МЕСЯЦ(A2)+1;6);ДАТА(ГОД(A2);МЕСЯЦ(A2)+1;5)))
Изменено: Ametist69 - 26 Апр 2019 15:55:02
Автонумерация первой строки через созданную форму
 
Можете файл пример приложить?
Укладка длинного столбца с данными в таблицу, состоящую из 21 строки.
 
А обязательно связать с ней?
Если обязательно пропишите ещё одну переменную, которая будет вытаскивать номер ячейки.

Просто вы сюда обращаетесь только за готовым решением? Или готовы сами подумать?
Укладка длинного столбца с данными в таблицу, состоящую из 21 строки.
 
Приложил файл с макросом.
На всякий случай код:
Код
Sub test()

NameBook = ActiveWorkbook.Name
NameSheet = ActiveSheet.Name
LastCells = Workbooks(NameBook).Worksheets(NameSheet).Cells(Rows.Count, 6).End(xlUp).Row
y = 17

For x = 7 To LastCells Step 21
    Range(Cells(x, 6), Cells(x + 20, 6)).Copy
    Worksheets(NameSheet).Cells(5, y).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    y = y + 1
Next
    
End Sub
При открытии файлов Excel с графиками и диаграммами возникает ошибка, При открытии файлов Excel с графиками и диаграммами возникает ошибка
 
Все последние обновления стоят. Самое странное что у коллег все те же обновы стоят. Но у них проблемы нет.
При открытии файлов Excel с графиками и диаграммами возникает ошибка, При открытии файлов Excel с графиками и диаграммами возникает ошибка
 
Цитата
Valo написал:
Чтобы исправить, я откатывал обновления и потом наотрез от них отказывался,
Спасибо за ответ! А какой-то другой способ решения не нашли?
При открытии файлов Excel с графиками и диаграммами возникает ошибка, При открытии файлов Excel с графиками и диаграммами возникает ошибка
 
Добрый день!
Можете подсказать, может кто-то сталкивался, при открытии любого файла Excel содержащего визуальные элементы (графики, диаграммы) возникает ошибка:
"Ошибка в части содержимого в книге *****. Выполнить попытку восстановления? Если вы доверяете источнику, из которого получена книга, нажмите кнопку "Да""
Скрины ошибки во вложении. Если нажать "Да", то из файла пропадают все графики и диаграммы.
У коллег этот же файл открывается нормально. Установлен Office 2016, переустанавливать пакет Office пробовал, на время решилась проблема, потом опять появилась.
Страницы: 1 2 3 След.
Наверх