Сравнение строк по значению одного столбца и перезапись если есть совпадения

@каролинка · Регистрация: 28.10.2012

Студворк — интернет-сервис помощи студентам

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

вот то, что я пыталась сделать, используя предыдущие решения для копирования

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 If flag = False Then
     Set wrkBook = Workbooks.Open(fnam$)
 With wrkBook.Worksheets("Database WEEKUREN")
 
 Set SourceRegion1 = wrkBook.Worksheets("Database WEEKUREN").Range("G:G").Cells.SpecialCells(xlCellTypeFormulas, 0)
 SearchVal1 = SourceRegion.Item(SourceRegion.Rows.Count, 1).Value
        For Each TempCell In SourceRegion
        For Each TempCell1 In SourceRegion1
           If TempCell.Value = SearchVal Then
           If TempCell1.Value = SearchVal1 Then
     TempCell.EntireRow.Copy
    wrkBook.Worksheets("Database WEEKUREN").Cells.SpecialCells(xlCellTypeLastCell) _
        .Offset(-1, -1).EntireRow.PasteSpecial (xlPasteValues)
       End If
       End If
       Next
       Next
           wrkBook.Close True
    End With

Пока мне на SpecialCells выдает unable to get SpecialCells or Range property
И я еще не пыталась вводить к критериям фамилию..

@каролинка · 03.11.2012, 11:50 **[ТС]**

Hugo121, в вашем файле все работает
а себе подставлю- каждый раз что-то новое ..
New folder (3).rar

@каролинка · 03.11.2012, 11:57 **[ТС]**

и как словари удалять, подскажите пожалуйста
а то после 400 ошибка выпадает+ к тем ошибкам, что уже есть

@Hugo121 · 03.11.2012, 12:38

Каролинка, вот зачем Вы привязали к кнопке макрос модуля листа, а не такой же из стандартного модуля?
Из листа он не работает! (Правда как-то не так, нужно отследить... я даже предположить не мог, что туда его воткнёте... Почему не работает - не изучал, но не удивлён - из листа есть ограничение по работе с другими листами.)
Короче, перепривязываете макрос к кнопке - и работает!
А как удалить объекты - сейчас хвост допишу, но не парьтесь - это не так важно...

Добавлено через 3 минуты
На примере не так потому, что там ничего нет в D - куда дели заголовки?

Добавлено через 6 минут
И как-то Вы копирование порезали - Вам не нужно суммирование часов?

Добавлено через 7 минут
Так, у Вас там в оригинале ещё фильтр в скрытом столбце прячет кучу строк без Activiteit - это тоже имеет значение. Вам нужны строки без активности или нет? Если не нужны - это нужно учесть в коде, такие не брать.

@каролинка · 03.11.2012, 12:38 **[ТС]**

я пыталась сделать все чтоб заработало)
надо попробовать привязать стандартный модуль,когда вернусь

@Hugo121 · 03.11.2012, 12:53

Вот это в стандартный модуль(!!!) и запустить:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
Option Explicit
 
Sub SearchAndReplace()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim a(), i&, t$, lrow&
    Dim dic1 As Object, dic2 As Object
    Dim ta, el
 
    With Application
        'отключаем отображение процесса
        .ScreenUpdating = False
        'отключаем события
        .EnableEvents = False
 
        'заводим словари (как собак :) )
        Set dic1 = CreateObject("Scripting.Dictionary")
        dic1.CompareMode = 1    'текстовое сравнение, тут не нужно, но не помешает - а вдруг?
        Set dic2 = CreateObject("Scripting.Dictionary")
        dic2.CompareMode = 1
 
        'будем копировать из активной книги, из ПЕРВОГО листа!
        Set wb1 = ActiveWorkbook
        'берём данные в массив, только нужные данные, критерии!
        With wb1.Sheets("UREN TABEL")
            a = Range(.[J1], .Range("D" & .Rows.Count).End(xlUp)).Value
        End With
        'цикл по массиву
        For i = 1 To UBound(a)
            If Trim(a(i, 1)) <> "" Then    'нужна фамилия!
                If Trim(a(i, 6)) <> "" Then    'нужна активность!
                    If Trim(a(i, 6)) <> "0" Then    'нужна активность!
                        If a(i, 1) <> "Mdw" Then    'но не эта! :)
                            t = a(i, 1) & "|" & a(i, 4) & "|" & a(i, 6)
                            With dic1
                                If Not .exists(t) Then    'если ещё нет в словаре
                                    ta = Array(i, a(i, 7))    'создаём и наполняем массив (2 элемента, но можно и ещё что-то занести)
                                    .Add t, ta    'заносим в словарь
                                Else    'если уже сть в словаре
                                    ta = .Item(t)    'извлекаем массив
                                    ta(0) = i: ta(1) = ta(1) + a(i, 7)    'обновляем данные
                                    .Item(t) = ta    'заносим массив назад
                                End If
                            End With
                        End If
                    End If
                End If
            End If
        Next
 
        'открываем вторую книгу - она лежит рядом с первой!
        Set wb2 = Workbooks.Open(wb1.Path & "\Master exa v1.xlsx")
        'берём данные в массив, только нужные данные, критерии!
        With wb2.Worksheets("Database WEEKUREN")
            a = Range(.Range("I1"), .Range("D" & .Rows.Count).End(xlUp)).Value
 
            lrow = UBound(a)    'сразу запоминаем первую пустую строку (где кончаются фамилии!)
            For i = 1 To UBound(a)
                If Trim(a(i, 1)) <> "" Then    'нужна фамилия!
                    If a(i, 1) <> "Mdw" Then    'но не эта! :)
                        'запоминаем в словаре с номером строки (его перезаписывать не придётся, тут только уникальные!)
                        dic2.Item(a(i, 1) & "|" & a(i, 4) & "|" & a(i, 6)) = i
                    End If
                End If
            Next
 
            For Each el In dic1.keys    'перебор ключей первого словаря
                If dic2.exists(el) Then    'если есть во втором словаре
                    'копируем строку первой книги, номер которой берём из первого словаря по ключу
                    'в строку второй книги, номер которой берём из второго словаря по ключу... уф...
                    wb1.Sheets("UREN TABEL").Rows(dic1.Item(el)(0)).Copy
                    .Rows(dic2.Item(el)).PasteSpecial xlPasteValuesAndNumberFormats
                    'заменяем часы на сумму часов
                    .Cells(dic2.Item(el), 10) = dic1.Item(el)(1)
                Else    ''если нет во втором словаре
                    lrow = lrow + 1    'увеличиваем номер строки, куда будем копировать
                    'и копируем аналогично как выше, но номер строки уже известен
                    wb1.Sheets("UREN TABEL").Rows(dic1.Item(el)(0)).Copy
                    .Rows(lrow).PasteSpecial xlPasteValuesAndNumberFormats
                    'заменяем часы на сумму часов
                    .Cells(lrow, 10) = dic1.Item(el)(1)
                End If
            Next
        End With
 
        Erase a
        Set wb1 = Nothing
        Set wb2 = Nothing
        Set dic1 = Nothing
        Set dic2 = Nothing
 
        'включаем события
        .EnableEvents = True
        'показываем что получилось
        .ScreenUpdating = True
 
    End With
End Sub

У меня работает. Но сперва в получателе поставил заголовки - вручную скопировал из источника.
Я там ещё поборолся с формулами и пустыми строками, и строками с нулями...

@каролинка · 03.11.2012, 13:16 **[ТС]**

да,мне там фильтр нужен тоже....

@Hugo121 · 03.11.2012, 13:44

Так последний вариант попробовали? (не хочу таких монстров плодить... в смысле файл

)
Только там коммент "из ПЕРВОГО листа!" лишнее, забыл убрать...

@каролинка · 03.11.2012, 15:56 **[ТС]**

сейчас нету возможности, но я еще отпишусь

Добавлено через 1 час 55 минут
Hugo121, спасибо вам большое-пребольшое за терпение и проделанную работу!все работает как надо

@Hugo121 · 03.11.2012, 16:42

Так всё же нужно было часы суммировать? (хочу заострить на этом внимание

)
Но тогда что-то нужно делать с датой - она некорректна.
Может туда собрать даты от-до - но что-то неохота это прописывать... Вот кто за язык тянет?

Добавлено через 24 минуты
Даты собираются в строку через "-". если они были разные:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
Sub SearchAndReplace()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim a(), i&, t$, lrow&
    Dim dic1 As Object, dic2 As Object
    Dim ta, el
 
    With Application
        'отключаем отображение процесса
        .ScreenUpdating = False
        'отключаем события
        .EnableEvents = False
 
        'заводим словари (как собак :) )
        Set dic1 = CreateObject("Scripting.Dictionary")
        dic1.CompareMode = 1    'текстовое сравнение, тут не нужно, но не помешает - а вдруг?
        Set dic2 = CreateObject("Scripting.Dictionary")
        dic2.CompareMode = 1
 
        'будем копировать из активной книги!
        Set wb1 = ActiveWorkbook
        'берём данные в массив, только нужные данные, критерии!
        With wb1.Sheets("UREN TABEL")
            a = Range(.[J1], .Range("D" & .Rows.Count).End(xlUp)).Value
        End With
        'цикл по массиву
        For i = 1 To UBound(a)
            If Trim(a(i, 1)) <> "" Then    'нужна фамилия!
                If Trim(a(i, 6)) <> "" Then    'нужна активность!
                    If Trim(a(i, 6)) <> "0" Then    'нужна активность!
                        If a(i, 1) <> "Mdw" Then    'но не эта! :)
                            t = a(i, 1) & "|" & a(i, 4) & "|" & a(i, 6)
                            With dic1
                                If Not .exists(t) Then    'если ещё нет в словаре
                                    ta = Array(i, a(i, 7), Trim(a(i, 2)), "")  'создаём и наполняем массив (2 элемента, но можно и ещё что-то занести)
                                    .Add t, ta    'заносим в словарь
                                Else    'если уже есть в словаре
                                    ta = .Item(t)    'извлекаем массив
                                    ta(0) = i: ta(1) = ta(1) + a(i, 7): ta(3) = Trim(a(i, 2))    'обновляем данные
                                    .Item(t) = ta    'заносим массив назад
                                End If
                            End With
                        End If
                    End If
                End If
            End If
        Next
 
        'открываем вторую книгу - она лежит рядом с первой!
        Set wb2 = Workbooks.Open(wb1.Path & "\Master exa v1.xlsx")
        'берём данные в массив, только нужные данные, критерии!
        With wb2.Worksheets("Database WEEKUREN")
            a = Range(.Range("I1"), .Range("D" & .Rows.Count).End(xlUp)).Value
 
            lrow = UBound(a)    'сразу запоминаем первую пустую строку (где кончаются фамилии!)
            For i = 1 To UBound(a)
                If Trim(a(i, 1)) <> "" Then    'нужна фамилия!
                    If a(i, 1) <> "Mdw" Then    'но не эта! :)
                        'запоминаем в словаре с номером строки (его перезаписывать не придётся, тут только уникальные!)
                        dic2.Item(a(i, 1) & "|" & a(i, 4) & "|" & a(i, 6)) = i
                    End If
                End If
            Next
 
            For Each el In dic1.keys    'перебор ключей первого словаря
                If dic2.exists(el) Then    'если есть во втором словаре
                    'копируем строку первой книги, номер которой берём из первого словаря по ключу
                    'в строку второй книги, номер которой берём из второго словаря по ключу... уф...
                    wb1.Sheets("UREN TABEL").Rows(dic1.Item(el)(0)).Copy
                    .Rows(dic2.Item(el)).PasteSpecial xlPasteValuesAndNumberFormats
                    ta = dic1.Item(el)
                    'заменяем часы на сумму часов
                    .Cells(dic2.Item(el), 10) = ta(1)
                    If ta(2) <> ta(3) Then    'если даты разные
                        If ta(3) <> "" Then
                            .Cells(dic2.Item(el), 5) = ta(2) & " - " & ta(3)
                        Else
                            .Cells(dic2.Item(el), 5) = ta(2)
                        End If
                    Else
                        .Cells(dic2.Item(el), 5) = ta(2)
                    End If
 
                Else    ''если нет во втором словаре
                    lrow = lrow + 1    'увеличиваем номер строки, куда будем копировать
                    'и копируем аналогично как выше, но номер строки уже известен
                    wb1.Sheets("UREN TABEL").Rows(dic1.Item(el)(0)).Copy
                    .Rows(lrow).PasteSpecial xlPasteValuesAndNumberFormats
                    ta = dic1.Item(el)
                    'заменяем часы на сумму часов
                    .Cells(lrow, 10) = ta(1)
                    If ta(2) <> ta(3) Then    'если даты разные
                        If ta(3) <> "" Then
                            .Cells(lrow, 5) = ta(2) & " - " & ta(3)
                        Else
                            .Cells(lrow, 5) = ta(2)
                        End If
                    Else
                        .Cells(lrow, 5) = ta(2)
                    End If
                End If
            Next
        End With
 
        Erase a
        Set wb1 = Nothing
        Set wb2 = Nothing
        Set dic1 = Nothing
        Set dic2 = Nothing
 
        'включаем события
        .EnableEvents = True
        'показываем что получилось
        .ScreenUpdating = True
 
    End With
End Sub

@каролинка · 03.11.2012, 16:47 **[ТС]**

Hugo121, суммировать вроде не нужно
хотя потом может и пригодится

@Hugo121 · 03.11.2012, 16:54

Так оно сейчас суммирует!
Вообще это важный вопрос - иначе всё неправильно! Т.е. часы неправильные!
Вот суммирование:

Visual Basic
1
ta(1) = ta(1) + a(i, 7)

@каролинка · 03.11.2012, 17:01 **[ТС]**

в принципе, я с вами согласна..пусть суммирует, спасибо)

можете еще подстазать, можно ли мне добавить msgbox с вопросом : вы уверены что хотите обновить данные? так, чтобы он не 10 раз спрашивал, а только раз

@Hugo121 · 03.11.2012, 17:09

Про msgbox не вполне понял. Вы ведь жмёте кнопку - не хотите обновлять - не жмите

Когда оно должно спрашивать? На каждого человека? Но ведь их в плане много...

@каролинка · 03.11.2012, 17:16 **[ТС]**

так вот я как добавила, так раз 15 пришлось окей нажимать)

@Hugo121 · 03.11.2012, 22:25

Ну в том и дело - человек много, на каждого выводить месидж... бестолково как-то.
Может быть вывести на форму листбокс, куда столбиком всех новых или старых, возможно ещё с какой то информацией - отмечаем галками кого хотим обновить, продолжаем.
Но если человек около 200 - то тоже как-то напряжно...
Это делать не буду - работы много, муторно... да и думаю в итоге никому не нужно.

@каролинка · 04.11.2012, 01:08 **[ТС]**

это да, согласна..

@каролинка · 05.11.2012, 15:20 **[ТС]**

копирует одну лишнюю строку(

Добавлено через 46 минут
Может кто подскажет что делать??

должно быть так

IMV	IMV N-NW-M	IMV N-NW-M	Bianca Hardus	5-Nov-12	1	45	11	Offreren, accepteren en produktie telefonie	8	Standaard tijd	IMV N-NW-M
IMV	IMV N-NW-M	IMV N-NW-M	Bianca Hardus	6-Nov-12	2	45	11	Offreren, accepteren en produktie telefonie	8	Standaard tijd	IMV N-NW-M
IMV	IMV N-NW-M	IMV N-NW-M	Bianca Hardus	7-Nov-12	3	45	11	Zakelijke aanvragen	8	Standaard tijd	IMV N-NW-M
IMV	IMV N-NW-M	IMV N-NW-M	Bianca Hardus	8-Nov-12	4	45	11	Zakelijke aanvragen	8	Standaard tijd	IMV N-NW-M
IMV	IMV N-NW-M	IMV N-NW-M	Bianca Hardus	9-Nov-12	5	45	11	Zakelijke aanvragen	8	Standaard tijd	IMV N-NW-M

а выходит так

IMV	IMV N-NW-M	IMV N-NW-M	Bianca Hardus	10-Nov-12	6	45	11	Produktie	0	0	0	0	Interne	36
IMV	IMV N-NW-M	IMV N-NW-M	Bianca Hardus	10-Nov-12	6	45	11	Offreren, accepteren en produktie telefonie	16	Standaard tijd	IMV N-NW-M	Thuis	Interne	36
IMV	IMV N-NW-M	IMV N-NW-M	Bianca Hardus	9-Nov-12	5	45	11	Zakelijke aanvragen	24	Standaard tijd	IMV N-NW-M	Thuis	Interne	36

@Hugo121 · 05.11.2012, 22:51

Если у кого есть время - попробуйте сделать отбор не по неделе, а по дню, и отфильтровать ненужные строки (по часам например).
Я смогу только вечером из дома глянуть - тут завал, и нет 2007.

Добавлено через 7 часов 7 минут
Этот вопрос решил в личке. Надеюсь устроит

Памирыч · 06.11.2012, 07:13

Комментарий модератора

Сообщение от Hugo121

Этот вопрос решил в личке

Устное предупреждение. Все решается в теме.

@Hugo121 · 06.11.2012, 11:09

Хорошо, резонно

Дублирую (чуть изменил несущественные мелочи):

Переделал на отбор по дням - поэтому есть разница в результатах, т.к. там в примере всюду один день, а недели разные (что так не должно быть в рабочем файле).
Теперь суммируются часы в одном фамилия|день|активейт
Плюс еще повтыкал там сям Application.StatusBar = "мессидж" - т.к. процесс не мнгновенный, пусть что-то пишет. Можно ещё писать счёт скопированных строк, если их много.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
Option Explicit
 
Sub SearchAndReplace()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim a(), i&, t$, lrow&
    Dim dic1 As Object, dic2 As Object
    Dim ta, el
    Dim fnam$
    Dim x As Range
    Dim Msg, Style, Title, Response
 
 
    fnam$ = Worksheets("Parameters").Range("A4").Value    'Address of Master database
    If Dir$(fnam$, vbNormal) <> "" Then    'If address is correct then
        With Application
            'shut off screen update
            .ScreenUpdating = False
            'shut off events
            .EnableEvents = False
 
            ThisWorkbook.Worksheets("UREN TABEL").AutoFilter.ApplyFilter    'update UREN TABEL sheet
 
            'create dictionary
            Set dic1 = CreateObject("Scripting.Dictionary")
            dic1.CompareMode = 1
            Set dic2 = CreateObject("Scripting.Dictionary")
            dic2.CompareMode = 1
 
            'we will copy from active book, UREN TABEl sheet
            Set wb1 = ActiveWorkbook
            'add data to array
            With wb1.Sheets("UREN TABEL")
                a = Range(.[J1], .Range("D" & .Rows.Count).End(xlUp)).Value
            End With
 
            .StatusBar = "Fill 1st Dictionary"
            'array cycle
            For i = 1 To UBound(a)
                If Trim(a(i, 1)) <> "" Then    'name and surname needed
                    If Trim(a(i, 6)) <> "" Then    'activity needed
                        If Trim(a(i, 6)) <> "0" Then    'activity needed
                            If Trim(a(i, 7)) <> "0" Then    'hours needed
                                If a(i, 1) <> "Mdw" Then    'but not thayt
                                    t = a(i, 1) & "|" & Format(a(i, 2), "dd.mm.yyyy") & "|" & a(i, 6)   'Mdw|Datum|Activeit
                                    With dic1
                                        If Not .exists(t) Then    'we don't have in dictionary
                                            ta = Array(i, a(i, 7))    'we create and fill in array _
                                                                      row number and hours sum
                                            .Add t, ta    'add to dictionary
                                        Else    'if we already have it in dictionary
                                            ta = .Item(t)    'extract array
                                            ta(0) = i: ta(1) = ta(1) + a(i, 7)    'update row number and sum hours of date
                                            .Item(t) = ta
                                        End If
                                    End With
                                End If
                            End If
                        End If
                    End If
                End If
            Next
 
           .StatusBar = "Open Master database from file"
            'open Master database from file
            Set wb2 = Workbooks.Open(fnam$)
            .StatusBar = "Fill 2st Dictionary"
            'add data to array
            With wb2.Worksheets("Database WEEKUREN")
                a = Range(.Range("I1"), .Range("D" & .Rows.Count).End(xlUp)).Value
 
                lrow = UBound(a)    'remember first free line
                For i = 1 To UBound(a)
                    If Trim(a(i, 1)) <> "" Then    'name and surname is needed
                        If a(i, 1) <> "Mdw" Then
                            'add to dictionary key and rows numbers
                            dic2.Item(a(i, 1) & "|" & Format(a(i, 2), "dd.mm.yyyy") & "|" & a(i, 6)) = i    'Mdw|Datum|Activeit
                        End If
                    End If
                Next
 
                Application.StatusBar = "Goes up data..."
                For Each el In dic1.keys    'browsing keys from 1st dictionary
                    If dic2.exists(el) Then    'if we have it in the 2nd dictionary
 
                        'copy line from Kopie van timesheet from 1st dictionary
                        'into master databases line from second dictionary
                        wb1.Sheets("UREN TABEL").Rows(dic1.Item(el)(0)).Copy
                        .Rows(dic2.Item(el)).PasteSpecial xlPasteValuesAndNumberFormats
                        'change hours on sum of hours(optional),delete single quotation mark in the following line to use
                        .Cells(dic2.Item(el), 10) = dic1.Item(el)(1)
                    Else    'if we don't have it in 2 dictionary
                        lrow = lrow + 1    'increase line number were we are going to copy
                        'and copy
                        wb1.Sheets("UREN TABEL").Rows(dic1.Item(el)(0)).Copy
                        .Rows(lrow).PasteSpecial xlPasteValuesAndNumberFormats
                        'change hours on sum of hours(optional),delete single quotation mark in the following line to use
                        .Cells(lrow, 10) = dic1.Item(el)(1)
                    End If
                Next
                wb2.Close True
            End With
 
            Erase a
            Set wb1 = Nothing
            Set wb2 = Nothing
            Set dic1 = Nothing
            Set dic2 = Nothing
 
            .StatusBar = "All is OK!"
            .CutCopyMode = False
            'turn on events
            .EnableEvents = True
            'turn on screen update
            .ScreenUpdating = True
            MsgBox "OK!", vbInformation
            .StatusBar = False
        End With
 
    Else
 
        Msg = Worksheets("Parameters").Range("A6").Value    'MsgBox2(nothing found) in Parameters worksheet
        Style = vbOKOnly
        Response = MsgBox(Msg, Style)
 
    End If
 
End Sub

Есть шероховатости - но т.к. это совместное творчество, то пусть остаются (например Title и Response совершенно ни к чему, но может они позже будут использоваться. Пара статусбаров тоже практически не видны, но если данных будут тысячи - то уже в них будет смысл)

Новые блоги и статьи Все статьи Все блоги /
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ" Adler 06.10.2026 Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	03.11.2012, 11:50 [ТС]
	Hugo121, в вашем файле все работает а себе подставлю- каждый раз что-то новое .. New folder (3).rar 0

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	03.11.2012, 11:57 [ТС]
	и как словари удалять, подскажите пожалуйста а то после 400 ошибка выпадает+ к тем ошибкам, что уже есть 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	03.11.2012, 12:38
	Каролинка, вот зачем Вы привязали к кнопке макрос модуля листа, а не такой же из стандартного модуля? Из листа он не работает! (Правда как-то не так, нужно отследить... я даже предположить не мог, что туда его воткнёте... Почему не работает - не изучал, но не удивлён - из листа есть ограничение по работе с другими листами.) Короче, перепривязываете макрос к кнопке - и работает! А как удалить объекты - сейчас хвост допишу, но не парьтесь - это не так важно... Добавлено через 3 минуты На примере не так потому, что там ничего нет в D - куда дели заголовки? Добавлено через 6 минут И как-то Вы копирование порезали - Вам не нужно суммирование часов? Добавлено через 7 минут Так, у Вас там в оригинале ещё фильтр в скрытом столбце прячет кучу строк без Activiteit - это тоже имеет значение. Вам нужны строки без активности или нет? Если не нужны - это нужно учесть в коде, такие не брать. 0

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	03.11.2012, 12:38 [ТС]
	я пыталась сделать все чтоб заработало) надо попробовать привязать стандартный модуль,когда вернусь 0

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	03.11.2012, 13:16 [ТС]
	да,мне там фильтр нужен тоже.... 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	03.11.2012, 13:44
	Так последний вариант попробовали? (не хочу таких монстров плодить... в смысле файл ) Только там коммент "из ПЕРВОГО листа!" лишнее, забыл убрать... 1

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	03.11.2012, 15:56 [ТС]
	сейчас нету возможности, но я еще отпишусь Добавлено через 1 час 55 минут Hugo121, спасибо вам большое-пребольшое за терпение и проделанную работу!все работает как надо 0

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	03.11.2012, 16:47 [ТС]
	Hugo121, суммировать вроде не нужно хотя потом может и пригодится 0

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	03.11.2012, 17:01 [ТС]
	в принципе, я с вами согласна..пусть суммирует, спасибо) можете еще подстазать, можно ли мне добавить msgbox с вопросом : вы уверены что хотите обновить данные? так, чтобы он не 10 раз спрашивал, а только раз 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	03.11.2012, 17:09
	Про msgbox не вполне понял. Вы ведь жмёте кнопку - не хотите обновлять - не жмите Когда оно должно спрашивать? На каждого человека? Но ведь их в плане много... 1

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	03.11.2012, 17:16 [ТС]
	так вот я как добавила, так раз 15 пришлось окей нажимать) 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	03.11.2012, 22:25
	Ну в том и дело - человек много, на каждого выводить месидж... бестолково как-то. Может быть вывести на форму листбокс, куда столбиком всех новых или старых, возможно ещё с какой то информацией - отмечаем галками кого хотим обновить, продолжаем. Но если человек около 200 - то тоже как-то напряжно... Это делать не буду - работы много, муторно... да и думаю в итоге никому не нужно. 0

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	04.11.2012, 01:08 [ТС]
	это да, согласна.. 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	05.11.2012, 22:51
	Если у кого есть время - попробуйте сделать отбор не по неделе, а по дню, и отфильтровать ненужные строки (по часам например). Я смогу только вечером из дома глянуть - тут завал, и нет 2007. Добавлено через 7 часов 7 минут Этот вопрос решил в личке. Надеюсь устроит 1