Создание новой таблицы на отдельном листе с данными соответс - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/Создание новой таблицы на отдельном листе с данными соответс - Мир MS Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание новой таблицы на отдельном листе с данными соответс (Макросы/Sub)

Создание новой таблицы на отдельном листе с данными соответс

Дата: Суббота, 25.10.2014, 22:29 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Здравствуйте.
Есть большая таблица, которую не очень удобно анализировать - таб1. Есть таблица поменьше - таб2. В обеих таблицах есть ключевое поле (D&B_ID). Надо на отдельном листе создать таблицу со столбцами D&B_ID, Cust_Customer и Cust_VAT Reg No. Последний столбец должех быть заполнен по принципу: если значение в столбце "Cust_VAT Reg No" в исходной таблице есть, то оно копируется в итоговую таблицу, если значение отсутствует, то туда надо скопировать соответствующее ключевому полю значение из столбца "D&B_NATIONAL IDENTIFICATION NUMBER" и выделить эту ячейку цветом. Цвета три и они зависят от значения в столбце D&B_Confidence Code. 7-10 -зеленый, 4-6 - желтый, 1-3 - розовый. Если отсутствуют значения и в первом и во втором столбцах, то ячейка остается пустой. Кроме того из итоговой таблицы должны быть исключены все записи, которые уже есть в таб2.

Хотелось бы написать макрос, который бы это все делал по нажатию кнопочки.

Может кто-нибудь помочь?

Ответить

Дата: Суббота, 25.10.2014, 22:31 | Сообщение № 2

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Не могу присоединить файл, т.к. даже самая маленькая часть исходника весит 937К. Что сделать?

Ответить

Дата: Суббота, 25.10.2014, 22:32 | Сообщение № 3

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Цитата Tunka-s, 25.10.2014 в 22:29, в сообщении № 1

Может кто-нибудь помочь?

Может.

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Суббота, 25.10.2014, 22:35 | Сообщение № 4

Группа: Админы

Ранг: Местный житель

Сообщений: 19184

Репутация: 4420 ±

Замечаний: ±

Excel 365 & Mac Excel

В Правилах форума написано

Цитата

- Чтобы понять и помочь - достаточно таблицы на 10-20 строк
- При этом старайтесь сохранить структуру, расположение таблиц, имена листов - аналогично оригиналу

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Дата: Суббота, 25.10.2014, 22:45 | Сообщение № 5

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Так я и оставила 20 строк! Ок, уберу все столбцы, кроме упомянутых выше. Кажется получилось.

К сообщению приложен файл: Test.xls (42.5 Kb)

Сообщение отредактировал Tunka-s - Суббота, 25.10.2014, 23:32

Ответить

Дата: Суббота, 25.10.2014, 22:46 | Сообщение № 6

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Цитата RAN, 25.10.2014 в 22:32, в сообщении № 3

Может кто-нибудь помочь?

Может.

Отлично!

Ответить

Дата: Воскресенье, 26.10.2014, 11:15 | Сообщение № 7

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

[vba]

Код

Sub Мяу()
     Dim arr1, arr2, arr3
     Dim i&, k&
     With Sheets("Tab1")
         arr1 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
     End With
     With Sheets("Tab2")
         arr2 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
     End With
     ReDim arr3(1 To UBound(arr1) + UBound(arr2), 1 To 5)
     With CreateObject("Scripting.Dictionary")
         For i = 1 To UBound(arr1)
             If Len(arr1(i, 3)) Then
                 arr1(i, 5) = Empty
             Else
                 arr1(i, 3) = arr1(i, 5)
                 If Len(arr1(i, 3)) Then
                     Select Case arr1(i, 4)
                     Case 1 To 3
                         arr1(i, 5) = 48
                     Case 4 To 6
                         arr1(i, 5) = 6
                     Case 7 To 10
                         arr1(i, 5) = 43
                     End Select
                 End If
             End If
             If Not .exists(arr1(i, 1)) Then
                 k = k + 1
                 arr3(k, 1) = arr1(i, 1)
                 arr3(k, 2) = arr1(i, 2)
                 arr3(k, 3) = arr1(i, 3)
                 arr3(k, 4) = arr1(i, 4)
                 arr3(k, 5) = arr1(i, 5)
                 .Item(arr1(i, 1)) = 1
             End If
         Next

         For i = 1 To UBound(arr2)
             If Len(arr2(i, 3)) Then
                 arr2(i, 5) = Empty
             Else
                 arr2(i, 3) = arr2(i, 5)
                 If Len(arr2(i, 3)) Then
                     Select Case arr2(i, 4)
                     Case 1 To 3
                         arr2(i, 5) = 48
                     Case 4 To 6
                         arr2(i, 5) = 6
                     Case 7 To 10
                         arr2(i, 5) = 43
                     End Select
                 End If
             End If
             If Not .exists(arr2(i, 1)) Then
                 k = k + 1
                 arr3(k, 1) = arr2(i, 1)
                 arr3(k, 2) = arr2(i, 2)
                 arr3(k, 3) = arr2(i, 3)
                 arr3(k, 4) = arr2(i, 4)
                 arr3(k, 5) = arr2(i, 5)
                 .Item(arr2(i, 1)) = 1
             End If
         Next

     End With
     With Sheets.Add
         .Cells(1, 1).Resize(k, 4).NumberFormat = "@"
         .Cells(1, 1).Resize(k, 4) = arr3
         For i = 1 To k
             If Len(arr3(i, 5)) Then
                 .Cells(i, 3).Interior.ColorIndex = arr3(i, 5)
             End If
         Next
     End With
End Sub

[/vba]

[vba]

Код

Sub Мяу()
     Dim arr1, arr2, arr3
     Dim i&, k&
     With Sheets("Tab1")
         arr1 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
     End With
     With Sheets("Tab2")
         arr2 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
     End With
     ReDim arr3(1 To UBound(arr1) + UBound(arr2), 1 To 5)
     With CreateObject("Scripting.Dictionary")
         For i = 1 To UBound(arr1)
             If Len(arr1(i, 3)) Then
                 arr1(i, 5) = Empty
             Else
                 arr1(i, 3) = arr1(i, 5)
                 If Len(arr1(i, 3)) Then
                     Select Case arr1(i, 4)
                     Case 1 To 3
                         arr1(i, 5) = 48
                     Case 4 To 6
                         arr1(i, 5) = 6
                     Case 7 To 10
                         arr1(i, 5) = 43
                     End Select
                 End If
             End If
             If Not .exists(arr1(i, 1)) Then
                 k = k + 1
                 arr3(k, 1) = arr1(i, 1)
                 arr3(k, 2) = arr1(i, 2)
                 arr3(k, 3) = arr1(i, 3)
                 arr3(k, 4) = arr1(i, 4)
                 arr3(k, 5) = arr1(i, 5)
                 .Item(arr1(i, 1)) = 1
             End If
         Next

         For i = 1 To UBound(arr2)
             If Len(arr2(i, 3)) Then
                 arr2(i, 5) = Empty
             Else
                 arr2(i, 3) = arr2(i, 5)
                 If Len(arr2(i, 3)) Then
                     Select Case arr2(i, 4)
                     Case 1 To 3
                         arr2(i, 5) = 48
                     Case 4 To 6
                         arr2(i, 5) = 6
                     Case 7 To 10
                         arr2(i, 5) = 43
                     End Select
                 End If
             End If
             If Not .exists(arr2(i, 1)) Then
                 k = k + 1
                 arr3(k, 1) = arr2(i, 1)
                 arr3(k, 2) = arr2(i, 2)
                 arr3(k, 3) = arr2(i, 3)
                 arr3(k, 4) = arr2(i, 4)
                 arr3(k, 5) = arr2(i, 5)
                 .Item(arr2(i, 1)) = 1
             End If
         Next

     End With
     With Sheets.Add
         .Cells(1, 1).Resize(k, 4).NumberFormat = "@"
         .Cells(1, 1).Resize(k, 4) = arr3
         For i = 1 To k
             If Len(arr3(i, 5)) Then
                 .Cells(i, 3).Interior.ColorIndex = arr3(i, 5)
             End If
         Next
     End With
End Sub

[/vba]RAN

Быть или не быть, вот в чем загвоздка!

Ответить

Сообщение[vba]

Код

Sub Мяу()
     Dim arr1, arr2, arr3
     Dim i&, k&
     With Sheets("Tab1")
         arr1 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
     End With
     With Sheets("Tab2")
         arr2 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
     End With
     ReDim arr3(1 To UBound(arr1) + UBound(arr2), 1 To 5)
     With CreateObject("Scripting.Dictionary")
         For i = 1 To UBound(arr1)
             If Len(arr1(i, 3)) Then
                 arr1(i, 5) = Empty
             Else
                 arr1(i, 3) = arr1(i, 5)
                 If Len(arr1(i, 3)) Then
                     Select Case arr1(i, 4)
                     Case 1 To 3
                         arr1(i, 5) = 48
                     Case 4 To 6
                         arr1(i, 5) = 6
                     Case 7 To 10
                         arr1(i, 5) = 43
                     End Select
                 End If
             End If
             If Not .exists(arr1(i, 1)) Then
                 k = k + 1
                 arr3(k, 1) = arr1(i, 1)
                 arr3(k, 2) = arr1(i, 2)
                 arr3(k, 3) = arr1(i, 3)
                 arr3(k, 4) = arr1(i, 4)
                 arr3(k, 5) = arr1(i, 5)
                 .Item(arr1(i, 1)) = 1
             End If
         Next

         For i = 1 To UBound(arr2)
             If Len(arr2(i, 3)) Then
                 arr2(i, 5) = Empty
             Else
                 arr2(i, 3) = arr2(i, 5)
                 If Len(arr2(i, 3)) Then
                     Select Case arr2(i, 4)
                     Case 1 To 3
                         arr2(i, 5) = 48
                     Case 4 To 6
                         arr2(i, 5) = 6
                     Case 7 To 10
                         arr2(i, 5) = 43
                     End Select
                 End If
             End If
             If Not .exists(arr2(i, 1)) Then
                 k = k + 1
                 arr3(k, 1) = arr2(i, 1)
                 arr3(k, 2) = arr2(i, 2)
                 arr3(k, 3) = arr2(i, 3)
                 arr3(k, 4) = arr2(i, 4)
                 arr3(k, 5) = arr2(i, 5)
                 .Item(arr2(i, 1)) = 1
             End If
         Next

     End With
     With Sheets.Add
         .Cells(1, 1).Resize(k, 4).NumberFormat = "@"
         .Cells(1, 1).Resize(k, 4) = arr3
         For i = 1 To k
             If Len(arr3(i, 5)) Then
                 .Cells(i, 3).Interior.ColorIndex = arr3(i, 5)
             End If
         Next
     End With
End Sub

[/vba]

Автор - RAN
Дата добавления - 26.10.2014 в 11:15

Дата: Воскресенье, 26.10.2014, 11:50 | Сообщение № 8

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

RAN, Спасибо вам огромное! Очень здорово, только почему-то записи которые есть в таб2 тоже добавляются в итоговую таблицу.

Ответить

Дата: Воскресенье, 26.10.2014, 12:20 | Сообщение № 9

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

[vba]

Код

Sub Мяв()
     Dim arr1, arr2, arr3
     Dim i&, k&
     With Sheets("Tab1")
         arr1 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
     End With
     With Sheets("Tab2")
         arr2 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
     End With
     ReDim arr3(1 To UBound(arr1), 1 To 5)
     With CreateObject("Scripting.Dictionary")
         For i = 1 To UBound(arr2)
             .Item(arr2(i, 1)) = 1
         Next
         k = 1
         arr3(k, 1) = arr1(1, 1)
         arr3(k, 2) = arr1(1, 2)
         arr3(k, 3) = arr1(1, 3)
         arr3(k, 4) = arr1(1, 4)
         arr3(k, 5) = arr1(1, 5)

         For i = 1 To UBound(arr1)
             If Not .exists(arr1(i, 1)) Then
                 k = k + 1
                 If Len(arr1(i, 3)) Then
                     arr1(i, 5) = Empty
                 Else
                     arr1(i, 3) = arr1(i, 5)
                     If Len(arr1(i, 3)) Then
                         Select Case arr1(i, 4)
                         Case 1 To 3
                             arr1(i, 5) = 48
                         Case 4 To 6
                             arr1(i, 5) = 6
                         Case 7 To 10
                             arr1(i, 5) = 43
                         End Select
                     End If
                 End If
                 arr3(k, 1) = arr1(i, 1)
                 arr3(k, 2) = arr1(i, 2)
                 arr3(k, 3) = arr1(i, 3)
                 arr3(k, 4) = arr1(i, 4)
                 arr3(k, 5) = arr1(i, 5)
                 .Item(arr1(i, 1)) = 1
             End If
         Next
     End With

     With Sheets.Add
         .Cells(1, 1).Resize(k, 4).NumberFormat = "@"
         .Cells(1, 1).Resize(k, 4) = arr3
         On Error Resume Next
         For i = 1 To k
             If Len(arr3(i, 5)) Then
                 .Cells(i, 3).Interior.ColorIndex = arr3(i, 5)
             End If
         Next
     End With

End Sub

[/vba]

[vba]

Код

Sub Мяв()
     Dim arr1, arr2, arr3
     Dim i&, k&
     With Sheets("Tab1")
         arr1 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
     End With
     With Sheets("Tab2")
         arr2 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
     End With
     ReDim arr3(1 To UBound(arr1), 1 To 5)
     With CreateObject("Scripting.Dictionary")
         For i = 1 To UBound(arr2)
             .Item(arr2(i, 1)) = 1
         Next
         k = 1
         arr3(k, 1) = arr1(1, 1)
         arr3(k, 2) = arr1(1, 2)
         arr3(k, 3) = arr1(1, 3)
         arr3(k, 4) = arr1(1, 4)
         arr3(k, 5) = arr1(1, 5)

         For i = 1 To UBound(arr1)
             If Not .exists(arr1(i, 1)) Then
                 k = k + 1
                 If Len(arr1(i, 3)) Then
                     arr1(i, 5) = Empty
                 Else
                     arr1(i, 3) = arr1(i, 5)
                     If Len(arr1(i, 3)) Then
                         Select Case arr1(i, 4)
                         Case 1 To 3
                             arr1(i, 5) = 48
                         Case 4 To 6
                             arr1(i, 5) = 6
                         Case 7 To 10
                             arr1(i, 5) = 43
                         End Select
                     End If
                 End If
                 arr3(k, 1) = arr1(i, 1)
                 arr3(k, 2) = arr1(i, 2)
                 arr3(k, 3) = arr1(i, 3)
                 arr3(k, 4) = arr1(i, 4)
                 arr3(k, 5) = arr1(i, 5)
                 .Item(arr1(i, 1)) = 1
             End If
         Next
     End With

     With Sheets.Add
         .Cells(1, 1).Resize(k, 4).NumberFormat = "@"
         .Cells(1, 1).Resize(k, 4) = arr3
         On Error Resume Next
         For i = 1 To k
             If Len(arr3(i, 5)) Then
                 .Cells(i, 3).Interior.ColorIndex = arr3(i, 5)
             End If
         Next
     End With

End Sub

[/vba]RAN

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Воскресенье, 26.10.2014, 12:26

Ответить

Сообщение[vba]

Код

Sub Мяв()
     Dim arr1, arr2, arr3
     Dim i&, k&
     With Sheets("Tab1")
         arr1 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
     End With
     With Sheets("Tab2")
         arr2 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
     End With
     ReDim arr3(1 To UBound(arr1), 1 To 5)
     With CreateObject("Scripting.Dictionary")
         For i = 1 To UBound(arr2)
             .Item(arr2(i, 1)) = 1
         Next
         k = 1
         arr3(k, 1) = arr1(1, 1)
         arr3(k, 2) = arr1(1, 2)
         arr3(k, 3) = arr1(1, 3)
         arr3(k, 4) = arr1(1, 4)
         arr3(k, 5) = arr1(1, 5)

         For i = 1 To UBound(arr1)
             If Not .exists(arr1(i, 1)) Then
                 k = k + 1
                 If Len(arr1(i, 3)) Then
                     arr1(i, 5) = Empty
                 Else
                     arr1(i, 3) = arr1(i, 5)
                     If Len(arr1(i, 3)) Then
                         Select Case arr1(i, 4)
                         Case 1 To 3
                             arr1(i, 5) = 48
                         Case 4 To 6
                             arr1(i, 5) = 6
                         Case 7 To 10
                             arr1(i, 5) = 43
                         End Select
                     End If
                 End If
                 arr3(k, 1) = arr1(i, 1)
                 arr3(k, 2) = arr1(i, 2)
                 arr3(k, 3) = arr1(i, 3)
                 arr3(k, 4) = arr1(i, 4)
                 arr3(k, 5) = arr1(i, 5)
                 .Item(arr1(i, 1)) = 1
             End If
         Next
     End With

     With Sheets.Add
         .Cells(1, 1).Resize(k, 4).NumberFormat = "@"
         .Cells(1, 1).Resize(k, 4) = arr3
         On Error Resume Next
         For i = 1 To k
             If Len(arr3(i, 5)) Then
                 .Cells(i, 3).Interior.ColorIndex = arr3(i, 5)
             End If
         Next
     End With

End Sub

[/vba]

Автор - RAN
Дата добавления - 26.10.2014 в 12:20

Дата: Воскресенье, 26.10.2014, 12:38 | Сообщение № 10

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Спасибо!

Правда новый код не работает:

Run time error 13
Type mismatch

.Cells(i, 3).Interior.ColorIndex = arr3(i, 5)

Ответить

Дата: Воскресенье, 26.10.2014, 13:00 | Сообщение № 11

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Я перевложил код, но уже поздно.

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Воскресенье, 26.10.2014, 13:20 | Сообщение № 12

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Ой, попробую еще раз!

Сообщение отредактировал Tunka-s - Воскресенье, 26.10.2014, 13:22

Ответить

Дата: Воскресенье, 26.10.2014, 13:25 | Сообщение № 13

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Спасибо огромное! То, что надо!!!

Ответить

Дата: Воскресенье, 26.10.2014, 14:47 | Сообщение № 14

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

А можно еще вопрос? Я тут пыталась "переделать" ваш код под свою таблицу, точнее поменяла номера столбцов только, у меня же их исходно очень много, и теперь куда-то делся цвет! Не посмотрите, что случилось?

[vba]

Код

Sub Macro1()
Dim arr1, arr2, arr3
Dim i&, k&
With Sheets("Total Duns Assigned and Append")
arr1 = .Range(.Cells(1, 30), .Cells(Rows.Count, 1).End(xlUp)).Value
End With
With Sheets("Matched_on_NatID")
arr2 = .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp)).Value
End With
ReDim arr3(1 To UBound(arr1), 1 To 5)
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr2)
.Item(arr2(i, 1)) = 1
Next
k = 1
arr3(k, 1) = arr1(1, 1)
arr3(k, 2) = arr1(1, 2)
arr3(k, 3) = arr1(1, 6)
arr3(k, 4) = arr1(1, 15)
arr3(k, 5) = arr1(1, 30)

For i = 1 To UBound(arr1)
If Not .exists(arr1(i, 1)) Then
k = k + 1
If Len(arr1(i, 6)) Then
arr1(i, 30) = Empty
Else
arr1(i, 6) = arr1(i, 30)
If Len(arr1(i, 6)) Then
Select Case arr1(i, 15)
Case 1 To 3
arr1(i, 5) = 48
Case 4 To 6
arr1(i, 5) = 6
Case 7 To 10
arr1(i, 5) = 43
End Select
End If
End If
arr3(k, 1) = arr1(i, 1)
arr3(k, 2) = arr1(i, 2)
arr3(k, 3) = arr1(i, 6)
arr3(k, 4) = arr1(i, 15)
arr3(k, 5) = arr1(i, 30)
.Item(arr1(i, 1)) = 1
End If
Next
End With

With Sheets.Add
.Cells(1, 1).Resize(k, 4).NumberFormat = "@"
.Cells(1, 1).Resize(k, 4) = arr3
On Error Resume Next
For i = 1 To k
If Len(arr3(i, 5)) Then
.Cells(i, 3).Interior.ColorIndex = arr3(i, 5)
End If
Next
End With

End Sub

[/vba]

Ответить

Дата: Воскресенье, 26.10.2014, 14:50 | Сообщение № 15

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Прошу прощения, уже поняла!

Ответить

Дата: Воскресенье, 26.10.2014, 16:48 | Сообщение № 16

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

А не подскажете, как присвоить новое имя активной странице? Потому что ActiveSheets.Name = "VAT Missed" не работает.

P.S. вопрос снят

Сообщение отредактировал Tunka-s - Воскресенье, 26.10.2014, 16:52

Ответить

Дата: Воскресенье, 26.10.2014, 17:29 | Сообщение № 17

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

А ведь наверняка существует какой-нибудь способ, чтобы в каждой строке листа, например в последней колонке поставить checkbox?
[moder]Вопрос не в тему. Читайте Правила форума[/moder]

Ответить

Дата: Воскресенье, 26.10.2014, 17:41 | Сообщение № 18

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Наверняка.
И макрорекордер этот код пишет.
Но я такие дурные хотелки не выполняю.
http://www.planetaexcel.ru/techniques/3/61/

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Воскресенье, 26.10.2014, 18:23 | Сообщение № 19

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

RAN, Thanks a lot!

Moderator: Sorry!

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание новой таблицы на отдельном листе с данными соответс (Макросы/Sub)

Страница 1 из 1
1

© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!