Chin_Chin (Все сообщения пользователя)

Макрос на форматирование, Необходимо реализовать макрос для форматирования по условиям.

Пользователь

Сообщений: 18 Регистрация: 31.01.2020

01.07.2021 13:05:32

Цитата
vikttur написал: Так ничего же непонятно. Что/как форматировать? Где "детальные условия"? Опишите задачу

В книге все расписано и есть пример.

Перейти

Макрос на форматирование, Необходимо реализовать макрос для форматирования по условиям.

Chin_Chin Пользователь Сообщений: 18 Регистрация: 31.01.2020	# 01.07.2021 12:32:58 Добрый день, детальные условия в файле. По оплате и деталям прошу писать в личку.
	Перейти

Три цвета заливки категорий в зависимости от количества принадлежащих им "линий"

Chin_Chin Пользователь Сообщений: 18 Регистрация: 31.01.2020	# 20.04.2021 09:37:28 Все отлично работает, большое тебе спасибо за помощь и открытие чего то нового) Изменено: Chin_Chin - 20.04.2021 15:09:43
	Перейти

Три цвета заливки категорий в зависимости от количества принадлежащих им "линий"

Chin_Chin Пользователь Сообщений: 18 Регистрация: 31.01.2020	# 20.04.2021 09:26:52 Разобрался, с утра туплю)
	Перейти

Три цвета заливки категорий в зависимости от количества принадлежащих им "линий"

Chin_Chin Пользователь Сообщений: 18 Регистрация: 31.01.2020	# 20.04.2021 09:22:21 Вас не затрунит немного объяснить формулу? =ISODD(COLUMN(E4))ISNUMBER(E4)(VLOOKUP($C4;$H$56:$I$58;2;)>E4) выделенный кусок не совсем ясен
	Перейти

Три цвета заливки категорий в зависимости от количества принадлежащих им "линий"

Chin_Chin

Пользователь

Сообщений: 18 Регистрация: 31.01.2020

19.04.2021 13:02:30

Всем привет, прошу помощи в сборке макроса. Своих мозгов совсем не хватает..

Необходимо форматирование по следующим параметрам:
В столбце С стоят категории, каждая категория должна ровняться своему количеству "линий" ( в книге указана снизу). Если цифра меньше указанной то цвет должен уйти в красный, если ровно или больше в зеленый.
Есть одна деталь, необходимо исключить из форматирования часы которые идут после столба "линии".

Перейти

Сравнение значений 2х столбцов с последующим копированием на другой лист.

Chin_Chin Пользователь Сообщений: 18 Регистрация: 31.01.2020	# 12.02.2021 14:32:23 evgeniygeo, Большое спасибо, вроде все работает!
	Перейти

Сравнение значений 2х столбцов с последующим копированием на другой лист.

Chin_Chin Пользователь Сообщений: 18 Регистрация: 31.01.2020	# 12.02.2021 13:48:45 Пример вложил. Сводная не подойдет так как файл и так слишком тяжелый + хранится на удаленке что увеличивает время открытия и обработки
	Перейти

Сравнение значений 2х столбцов с последующим копированием на другой лист.

Chin_Chin

Пользователь

Сообщений: 18 Регистрация: 31.01.2020

12.02.2021 13:34:15

Всем привет, не совсем понимаю как написать макрос.
Цель:
Если диапазон C2:C80 > N2:N80
То скопировать эти диапазоны + B2 (где находится описание) и вставить на отдельный лист.
То же самое если C2:C80 < N2:N80

	Лист 1						Лист 2
ФИО	количество	стандарт		Больше			Меньше			Ровно
Иванов	5	8	Петров	6	5	Иванов	5	8	Михайлов	4	4
Петров	6	5	Сидоров	7	6	Иващенко	9	11
Сидоров	7	6
Михайлов	4	4
Иващенко	9	11

Перейти

Отчет проходок, Подсчет и поиск по нескольким значениям

Chin_Chin Пользователь Сообщений: 18 Регистрация: 31.01.2020	# 24.04.2020 15:07:12 Работу исполянют. Тему можно считать закрытой.
	Перейти

Отчет проходок, Подсчет и поиск по нескольким значениям

Chin_Chin Пользователь Сообщений: 18 Регистрация: 31.01.2020	# 24.04.2020 08:10:49 Необходимо высчитать проведенное время на складе сотрудником.
	Перейти

Пароль, Пароль VBA

Chin_Chin Пользователь Сообщений: 18 Регистрация: 31.01.2020	# 12.02.2020 09:34:37 Понял Вас, в следующий раз учту это. Да, пароль нашел и все убрал. Большое спасибо за помощь!
	Перейти

Пароль, Пароль VBA

Chin_Chin

Пользователь

Сообщений: 18 Регистрация: 31.01.2020

12.02.2020 08:52:57

Цитата
Polkilo написал: Пароль НЕ на листе listok, название темы предложите

Не понял на счет темы.
Пароль Sheets("INDEX").Cells(2, 109)?

Перейти

Пароль, Пароль VBA

Chin_Chin

Пользователь

Сообщений: 18 Регистрация: 31.01.2020

12.02.2020 08:46:09

Цитата
Андрей_26 написал: Workbooks(rasp).Sheets(listok).Protect Password:=codd

С названием конечно я намудрил..
нет, в этой ячейке нет кода к листам.

Перейти

Пароль, Пароль VBA

Chin_Chin

Пользователь

Сообщений: 18 Регистрация: 31.01.2020

12.02.2020 08:36:52

Доброго дня всем гуру Excel и VBA!
В наследство досталась полезная книга с кучей макросов.
Проблема заключается в том, что зная пароль от листов невозможно сбросить его. Снимая пароли и сохраняя книгу, далее открыв ее заново там вновь стоят те же самые пароли. Не может ли в коде стоять автообновление паролей листов?

Код

Sub unpaidd()
    rasp = Application.ActiveWorkbook.Name
    listok = Application.ActiveSheet.Name
    With Workbooks(rasp)
        .Activate
        With .Sheets(listok)
            o = Application.WorksheetFunction.Sum(.Range("A2:AG2"))
            If o > 0 Then
                unp = Workbooks(rasp).Sheets("STAT").Cells(2, 99).Value
                unpr = Workbooks(rasp).Sheets("STAT").Cells(3, 99).Value
                rc1 = Workbooks(rasp).Sheets("STAT").Cells(6, 75).Value
                rc2 = Workbooks(rasp).Sheets("STAT").Cells(7, 75).Value
                r1 = Workbooks(rasp).Sheets("STAT").Cells(3, 73).Value
                r2 = Workbooks(rasp).Sheets("STAT").Cells(4, 73).Value
                r3 = Workbooks(rasp).Sheets("STAT").Cells(5, 73).Value
                r4 = Workbooks(rasp).Sheets("STAT").Cells(6, 73).Value
                r5 = Workbooks(rasp).Sheets("STAT").Cells(7, 73).Value
                r6 = Workbooks(rasp).Sheets("STAT").Cells(8, 73).Value
                s3 = Workbooks(rasp).Sheets("STAT").Cells(4, 76).Value
                yo = Application.WorksheetFunction.CountA(.Range("" & s3 & "" & r1 & ":" & s3 & "" & r2 & ""))
                yi = Application.WorksheetFunction.CountA(.Range("" & s3 & "" & r3 & ":" & s3 & "" & r4 & ""))
                yt = Application.WorksheetFunction.CountA(.Range("" & s3 & "" & r4 & ":" & s3 & "" & r6 & ""))
                q = rc1
                Do While q <= rc2
                    If o > 0 Then
                        If .Cells(2, q).Value = 1 Then
                            If yo > 0 Then
                                .Range(Cells(r1, q), Cells(r1 + yo - 1, q)).Value = unp
                            End If
                            If yi > 0 Then
                                .Range(Cells(r3, q), Cells(r3 + yi - 1, q)).Value = unp
                            End If
                            If yt > 0 Then
                                .Range(Cells(r5, q), Cells(r5 + yt - 1, q)).Value = unp
                            End If
                            o = o - 1
                        End If
                        If .Cells(2, q).Value = 2 Then
                            If yo > 0 Then
                                .Range(Cells(r1, q), Cells(r1 + yo - 1, q)).Value = unpr
                            End If
                            If yi > 0 Then
                                .Range(Cells(r3, q), Cells(r3 + yi - 1, q)).Value = unpr
                            End If
                            If yt > 0 Then
                                .Range(Cells(r5, q), Cells(r5 + yt - 1, q)).Value = unpr
                            End If
                            o = o - 2
                        End If
                    Else
                        q = rc2
                    End If
                    q = q + 1
                Loop
            End If
        End With
    End With
End Sub
Sub unpaidn()
    rasp = Application.ActiveWorkbook.Name
    listok = Application.ActiveSheet.Name
    With Workbooks(rasp)
        .Activate
        With .Sheets(listok)
            o = Application.WorksheetFunction.Sum(.Range("AP2:BO2"))
            If o > 0 Then
                unp = Workbooks(rasp).Sheets("STAT").Cells(2, 99).Value
                unpr = Workbooks(rasp).Sheets("STAT").Cells(3, 99).Value
                rc3 = Workbooks(rasp).Sheets("STAT").Cells(8, 75).Value
                rc4 = Workbooks(rasp).Sheets("STAT").Cells(9, 75).Value
                r1 = Workbooks(rasp).Sheets("STAT").Cells(3, 73).Value
                r2 = Workbooks(rasp).Sheets("STAT").Cells(4, 73).Value
                r3 = Workbooks(rasp).Sheets("STAT").Cells(5, 73).Value
                r4 = Workbooks(rasp).Sheets("STAT").Cells(6, 73).Value
                r5 = Workbooks(rasp).Sheets("STAT").Cells(7, 73).Value
                r6 = Workbooks(rasp).Sheets("STAT").Cells(8, 73).Value
                s4 = Workbooks(rasp).Sheets("STAT").Cells(5, 76).Value
                xo = Application.WorksheetFunction.CountA(.Range("" & s4 & "" & r1 & ":" & s4 & "" & r2 & ""))
                q = rc3
                Do While q <= rc4
                    If o > 0 Then
                        If .Cells(2, q).Value = 1 Then
                            If xo > 0 Then
                                .Range(Cells(r1, q), Cells(r1 + xo - 1, q)).Value = unp
                            End If
                            o = o - 1
                        End If
                        If .Cells(2, q).Value = 2 Then
                            If xo > 0 Then
                                .Range(Cells(r1, q), Cells(r1 + xo - 1, q)).Value = unpr
                            End If
                            o = o - 2
                        End If
                    Else
                        q = rc4
                    End If
                    q = q + 1
                Loop
            End If
        End With
    End With
End Sub
Sub fild()
    rasp = Application.ActiveWorkbook.Name
    listok = Application.ActiveSheet.Name
    With Workbooks(rasp)
        .Activate
        With .Sheets(listok)
            rc1 = Workbooks(rasp).Sheets("STAT").Cells(6, 75).Value
            rc2 = Workbooks(rasp).Sheets("STAT").Cells(7, 75).Value
            c1 = Workbooks(rasp).Sheets("STAT").Cells(6, 76).Value
            c2 = Workbooks(rasp).Sheets("STAT").Cells(7, 76).Value
            r1 = Workbooks(rasp).Sheets("STAT").Cells(3, 73).Value
            r2 = Workbooks(rasp).Sheets("STAT").Cells(4, 73).Value
            r3 = Workbooks(rasp).Sheets("STAT").Cells(5, 73).Value
            r4 = Workbooks(rasp).Sheets("STAT").Cells(6, 73).Value
            r5 = Workbooks(rasp).Sheets("STAT").Cells(7, 73).Value
            r6 = Workbooks(rasp).Sheets("STAT").Cells(8, 73).Value
            s1 = Workbooks(rasp).Sheets("STAT").Cells(4, 75).Value
            p1 = Workbooks(rasp).Sheets("STAT").Cells(2, 75).Value
            p3 = Workbooks(rasp).Sheets("STAT").Cells(2, 76).Value
            ss1 = Workbooks(rasp).Sheets("STAT").Cells(12, 76).Value
            sd = Workbooks(rasp).Sheets("STAT").Cells(10, 99).Value
            yo = Application.WorksheetFunction.CountA(.Range("" & p3 & "" & r1 & ":" & p3 & "" & r2 & ""))
            yi = Application.WorksheetFunction.CountA(.Range("" & p3 & "" & r3 & ":" & p3 & "" & r4 & ""))
            yt = Application.WorksheetFunction.CountA(.Range("" & p3 & "" & r5 & ":" & p3 & "" & r6 & ""))
            If yo > 0 Then
                q = r1
                Do While q <= r1 + yo - 1
                    If .Cells(q, p1).Value <> "" Then
                        Z = Application.WorksheetFunction.Match(.Range("" & p3 & "" & q & "").Value, Workbooks(rasp).Sheets("STAT").Range("CK1:CK40"), 0)
                        .Cells(q, s1).Value = Workbooks(rasp).Sheets("STAT").Range("CL" & Z).Value
                        .Range("" & c1 & "" & q & ":" & c2 & "" & q & "").Value = .Cells(q, s1).Value
                        If .Range("" & ss1 & "" & q & "").Value = "" Then
                            .Range("" & ss1 & "" & q & "").Value = sd
                        End If
                    End If
                    q = q + 1
                Loop
            End If
            If yi > 0 Then
                q = r3
                Do While q <= r3 + yi - 1
                    If .Cells(q, p1).Value <> "" Then
                         Z = Application.WorksheetFunction.Match(.Range("" & p3 & "" & q & ""), Workbooks(rasp).Sheets("STAT").Range("CN1:CN40"), 0)
                        .Cells(q, s1).Value = Workbooks(rasp).Sheets("STAT").Range("CO" & Z).Value
                        .Range("" & c1 & "" & q & ":" & c2 & "" & q & "").Value = .Cells(q, s1).Value
                        If .Range("" & ss1 & "" & q & "").Value = "" Then
                            .Range("" & ss1 & "" & q & "").Value = sd
                        End If
                    End If
                    q = q + 1
                Loop
            End If
            If yt > 0 Then
                q = r5
                Do While q <= r5 + yt - 1
                    If .Cells(q, p1).Value <> "" Then
                         Z = Application.WorksheetFunction.Match(.Range("" & p3 & "" & q & ""), Workbooks(rasp).Sheets("STAT").Range("CQ1:CQ40"), 0)
                        .Cells(q, s1).Value = Workbooks(rasp).Sheets("STAT").Range("CR" & Z).Value
                        .Range("" & c1 & "" & q & ":" & c2 & "" & q & "").Value = .Cells(q, s1).Value
                        If .Range("" & ss1 & "" & q & "").Value = "" Then
                            .Range("" & ss1 & "" & q & "").Value = sd
                        End If
                    End If
                    q = q + 1
                Loop
            End If
        End With
    End With
End Sub
Sub filn()
    rasp = Application.ActiveWorkbook.Name
    listok = Application.ActiveSheet.Name
    With Workbooks(rasp)
        .Activate
        With .Sheets(listok)
            rc3 = Workbooks(rasp).Sheets("STAT").Cells(8, 75).Value
            rc4 = Workbooks(rasp).Sheets("STAT").Cells(9, 75).Value
            c3 = Workbooks(rasp).Sheets("STAT").Cells(8, 76).Value
            c4 = Workbooks(rasp).Sheets("STAT").Cells(9, 76).Value
            r1 = Workbooks(rasp).Sheets("STAT").Cells(3, 73).Value
            r2 = Workbooks(rasp).Sheets("STAT").Cells(4, 73).Value
            r3 = Workbooks(rasp).Sheets("STAT").Cells(5, 73).Value
            r4 = Workbooks(rasp).Sheets("STAT").Cells(6, 73).Value
            r5 = Workbooks(rasp).Sheets("STAT").Cells(7, 73).Value
            r6 = Workbooks(rasp).Sheets("STAT").Cells(8, 73).Value
            s2 = Workbooks(rasp).Sheets("STAT").Cells(5, 75).Value
            p2 = Workbooks(rasp).Sheets("STAT").Cells(3, 75).Value
            p4 = Workbooks(rasp).Sheets("STAT").Cells(3, 76).Value
            ss2 = Workbooks(rasp).Sheets("STAT").Cells(13, 76).Value
            sd = Workbooks(rasp).Sheets("STAT").Cells(10, 99).Value
            xo = Application.WorksheetFunction.CountA(.Range("" & p4 & "" & r1 & ":" & p4 & "" & r2 & ""))
            xi = Application.WorksheetFunction.CountA(.Range("" & p4 & "" & r3 & ":" & p4 & "" & r4 & ""))
            xt = Application.WorksheetFunction.CountA(.Range("" & p4 & "" & r5 & ":" & p4 & "" & r6 & ""))
            If xo > 0 Then
                q = r1
                Do While q <= r1 + xo - 1
                    If .Cells(q, p2).Value <> "" Then
                        Z = Application.WorksheetFunction.Match(.Range("" & p4 & "" & q & ""), Workbooks(rasp).Sheets("STAT").Range("CK1:CK40"), 0)
                        .Cells(q, s2).Value = Workbooks(rasp).Sheets("STAT").Range("CL" & Z).Value
                        .Range("" & c3 & "" & q & ":" & c4 & "" & q & "").Value = .Cells(q, s2).Value
                        If .Range("" & ss2 & "" & q & "").Value = "" Then
                            .Range("" & ss2 & "" & q & "").Value = sd
                        End If
                    End If
                    q = q + 1
                Loop
            End If
            If xi > 0 Then
                q = r3
                Do While q <= r3 + xi - 1
                    If .Cells(q, p2).Value <> "" Then
                        Z = Application.WorksheetFunction.Match(.Range("" & p4 & "" & q & ""), Workbooks(rasp).Sheets("STAT").Range("CN1:CN40"), 0)
                        .Cells(q, s2).Value = Workbooks(rasp).Sheets("STAT").Range("CO" & Z).Value
                        .Range("" & c3 & "" & q & ":" & c4 & "" & q & "").Value = .Cells(q, s2).Value
                        If .Range("" & ss2 & "" & q & "").Value = "" Then
                            .Range("" & ss2 & "" & q & "").Value = sd
                        End If
                    End If
                    q = q + 1
                Loop
            End If
            If xt > 0 Then
                q = r5
                Do While q <= r5 + xt - 1
                    If .Cells(q, p2).Value <> "" Then
                        Z = Application.WorksheetFunction.Match(.Range("" & p4 & "" & q & ""), Workbooks(rasp).Sheets("STAT").Range("CQ1:CQ40"), 0)
                        .Cells(q, s2).Value = Workbooks(rasp).Sheets("STAT").Range("CR" & Z).Value
                        .Range("" & c3 & "" & q & ":" & c4 & "" & q & "").Value = .Cells(q, s2).Value
                        If .Range("" & ss2 & "" & q & "").Value = "" Then
                            .Range("" & ss2 & "" & q & "").Value = sd
                        End If
                    End If
                    q = q + 1
                Loop
            End If
        End With
    End With
End Sub
Sub cvet()
    rasp = Application.ActiveWorkbook.Name
    listok = Application.ActiveSheet.Name
    With Workbooks(rasp)
        .Activate
        codd = Workbooks(rasp).Sheets("INDEX").Cells(2, 109).Value
        Workbooks(rasp).Sheets(listok).Unprotect codd
        With .Sheets(listok)
            Cells.Select
            Selection.FormatConditions.Delete
            r1 = Workbooks(rasp).Sheets("STAT").Cells(2, 86).Value
            r2 = Workbooks(rasp).Sheets("STAT").Cells(2, 87).Value
            c1 = Workbooks(rasp).Sheets("STAT").Cells(4, 76).Value
            c2 = Workbooks(rasp).Sheets("STAT").Cells(9, 76).Value
            y = Application.WorksheetFunction.CountA(Workbooks(rasp).Sheets("STAT").Range("CH:CH")) - 1
            q = 2
            .Range("" & c1 & "" & r1 & ":" & c2 & "" & r2 & "").Select
            Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ISERROR(A6)"
            Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
            With Selection.FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 255
                .TintAndShade = 0
            End With
            Selection.FormatConditions(1).StopIfTrue = False
            Do While q <= 1 + y
                x = Workbooks(rasp).Sheets("STAT").Cells(q, 85).Interior.Color
                If Workbooks(rasp).Sheets("STAT").Cells(q, 85).Value = Workbooks(rasp).Sheets("STAT").Cells(2, 99).Value Then
                    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=STAT!$CG$" & q & ""
                    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
                    With Selection.FormatConditions(1).Font
                        .Bold = True
                        .Italic = False
                        .ThemeColor = xlThemeColorDark1
                        .TintAndShade = 0
                    End With
                    With Selection.FormatConditions(1).Interior
                        .PatternColorIndex = xlAutomatic
                        .Color = x
                        .TintAndShade = 0
                    End With
                    Selection.FormatConditions(1).StopIfTrue = False
                Else
                    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=STAT!$CG$" & q & ""
                    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
                    With Selection.FormatConditions(1).Interior
                        .PatternColorIndex = xlAutomatic
                        .Color = x
                        .TintAndShade = 0
                    End With
                    Selection.FormatConditions(1).StopIfTrue = False
                End If
                q = q + 1
            Loop
            .Cells(1, 1).Select
        End With
        Workbooks(rasp).Sheets(listok).Protect Password:=codd, DrawingObjects:=False, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
    End With
End Sub
Sub allpressday()
    Call fild
    Call unpaidd
    Call cvet
End Sub
Sub allpressnight()
    Call filn
    Call unpaidn
    Call cvet
End Sub

Самостоятельно я не нашел в данном коде что то связанное с паролями

Перейти

Из несколько книг в одну, макрос., проблема с кодом.

Chin_Chin

Пользователь

Сообщений: 18 Регистрация: 31.01.2020

31.01.2020 11:18:23

Цитата
Nordheim написал: Так зачем цикл по листам, переносите этот лист, но если наименование листа во всех файлах одинаковое, то после переноса имя нужно поменять, в противном случае может вывалится ошибка совпадения листов.

Поломок нет, но все равно я не понял как выправить код.. Я почти что полный 0 в этом пока.

Перейти

Из несколько книг в одну, макрос., проблема с кодом.

Chin_Chin

Пользователь

Сообщений: 18 Регистрация: 31.01.2020

31.01.2020 11:03:29

Цитата
Nordheim написал: Код оформите правильно кнопкой , Необходим список идентификатор листов которые должны быть перемещены

Лист - Data.
И не совсем понял на счет правильной кнопки.

Перейти

Из несколько книг в одну, макрос., проблема с кодом.

Chin_Chin

Пользователь

Сообщений: 18 Регистрация: 31.01.2020

31.01.2020 09:17:24

Добрыйд день, есть кривокод который я не пойму как добить.
Задача вытащить только определенные листы из книг а не всю целиком.

Sub GetSheets()
Path = "\\********\Pr\Documentation\Analytics\Auto\"
Filename = Dir(Path & "*.xlsm")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy after:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

Перейти