Работа с xls - сравнение столбцов, с примерами в ТЗ - Мир MS Excel

Регистрация

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

= Мир MS Excel/Работа с xls - сравнение столбцов, с примерами в ТЗ - Мир MS Excel

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

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

Работа с xls - сравнение столбцов, с примерами в ТЗ

Работа с xls - сравнение столбцов, с примерами в ТЗ

Дата: Воскресенье, 24.06.2012, 01:18 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 11

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

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

Условия:
1. Есть первый столбец со списком значений
2. Есть второй и третий (связанны) столбцы со списком значений
3. Второй столбец частично совпадает с первым, например:

первый столбец: Котельное оборудование Quasar D 24 i
второй столбец: QUASAR D 24 i

Задача:
Распределить данные по строкам из второго столбца по частичному совпадению с первым столбцом, т.е. пример на скриншотах
было:

должно быть:

К сообщению приложен файл: _-.xlsx (85.8 Kb)

Сообщение отредактировал Anatoliy45 - Воскресенье, 24.06.2012, 02:06

Ответить

Дата: Воскресенье, 24.06.2012, 01:33 | Сообщение № 2

Группа: Авторы

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

Сообщений: 120

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

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

Вы уже на "Планете" написали, неужели трудно подождать с ответом?
Я там уже Вам отписал, что делать.
Ps. Без файла-примера в формате xls - Вам никто не поможет.

E-mail: overseerpower@gmail.com
Skype: Bogdan_Rud
WMR: R166238237296

Ответить

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

Группа: Пользователи

Ранг: Новичок

Сообщений: 11

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

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

пример прикрепил, помогите пожалуйста, нужна пошаговая инструкция что делать, ибо в excel я новичок

Ответить

Дата: Воскресенье, 24.06.2012, 05:59 | Сообщение № 4

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

Ранг: Старожил

Сообщений: 2369

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

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

2003-2010

Еще и здесь: http://www.programmersforum.ru/showthread.php?t=205998

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

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

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

Ранг: Участник клуба

Сообщений: 2797

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

Замечаний: ±

начинал с Excel 4.0, видел 2.1

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

Схематично даю шаги решения, которые проделал я. Это больше даже себе узелок на память, нежели автору вопроса. Объяснять подробно ничего не буду, ибо как справедливо было замечено на другом форуме: в одном сообщении программировать на VBA не научить.

Прилагаемый к этому сообщению файл был получен на полном количестве строк оборудования и перед окончательным сохранением этот список на Листе1 был урезан до 2000 строк, чтобы уложиться в разрешенные к публикации на форуме 100 кб.

Итак, 1-й шаг - оценка объемов информации для обработки. Список оборудования - 6705 строк, список марок - 47 строк (подозреваю, далеко не полный). В процессе просмотра таблицы замечаю лишние пробелы между словами, поэтому

2-й шаг - сжатие пробелов соответствующей функцией в "Оборудовании" и в "Марках", результат - в колонках "Оборудование СЖПРОБЕЛЫ" и "Марка СЖПРОБЕЛЫ". В процессе просмотра таблицы таже было замечено большое количество повторяющихся строк оборудования, поэтому

3-й шаг - получение уникальных значений оборудования, при помощи расширенного фильтра по колонке Лист1!D ("Оборудование СЖПРОБЕЛЫ") и копировании отфильтрованных значений в колонку Лист3!A. Получилось 1022 уникальных значения из первоначальных 6705 строк. Что ж, сокращение внушительное, впору сказать: "Тыщу-то и глазками можно отсмотреть", но будем пытаться ужаться еще, поэтому

4-й шаг - написание макроса на VBA и его прогон. Макрос бежит по колонке Лист3!A ("Уникальные Оборудование СЖПРОБЕЛЫ"), в каждом значении оборудования ищет все значения марок из Лист1!E ("Марка СЖПРОБЕЛЫ"), при нахождении записывает конкретную марку напротив конкретного оборудования в соседнюю колонку Лист3!B ("Привязанные Марка СЖПРОБЕЛЫ").

5-й шаг - "перенос" значений марок в первоначальную таблицу, см. формулу в колонке Лист1!F ("Привязка Марки к Оборудованию") с использованием функций ИНДЕКС и ПОИСКПОЗ. Соотвественно, строки, где получился "0" (т.е. не получилась привязка) надо будет отфильтровать и попробовать привязать к ним марки вручную визуальным просмотром таблицы, поэтому неизбежен

6-й шаг - ручная привязка еще не привязанных марок.

Вот как-то так...

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

Схематично даю шаги решения, которые проделал я. Это больше даже себе узелок на память, нежели автору вопроса. Объяснять подробно ничего не буду, ибо как справедливо было замечено на другом форуме: в одном сообщении программировать на VBA не научить.

Прилагаемый к этому сообщению файл был получен на полном количестве строк оборудования и перед окончательным сохранением этот список на Листе1 был урезан до 2000 строк, чтобы уложиться в разрешенные к публикации на форуме 100 кб.

Итак, 1-й шаг - оценка объемов информации для обработки. Список оборудования - 6705 строк, список марок - 47 строк (подозреваю, далеко не полный). В процессе просмотра таблицы замечаю лишние пробелы между словами, поэтому

2-й шаг - сжатие пробелов соответствующей функцией в "Оборудовании" и в "Марках", результат - в колонках "Оборудование СЖПРОБЕЛЫ" и "Марка СЖПРОБЕЛЫ". В процессе просмотра таблицы таже было замечено большое количество повторяющихся строк оборудования, поэтому

3-й шаг - получение уникальных значений оборудования, при помощи расширенного фильтра по колонке Лист1!D ("Оборудование СЖПРОБЕЛЫ") и копировании отфильтрованных значений в колонку Лист3!A. Получилось 1022 уникальных значения из первоначальных 6705 строк. Что ж, сокращение внушительное, впору сказать: "Тыщу-то и глазками можно отсмотреть", но будем пытаться ужаться еще, поэтому

4-й шаг - написание макроса на VBA и его прогон. Макрос бежит по колонке Лист3!A ("Уникальные Оборудование СЖПРОБЕЛЫ"), в каждом значении оборудования ищет все значения марок из Лист1!E ("Марка СЖПРОБЕЛЫ"), при нахождении записывает конкретную марку напротив конкретного оборудования в соседнюю колонку Лист3!B ("Привязанные Марка СЖПРОБЕЛЫ").

5-й шаг - "перенос" значений марок в первоначальную таблицу, см. формулу в колонке Лист1!F ("Привязка Марки к Оборудованию") с использованием функций ИНДЕКС и ПОИСКПОЗ. Соотвественно, строки, где получился "0" (т.е. не получилась привязка) надо будет отфильтровать и попробовать привязать к ним марки вручную визуальным просмотром таблицы, поэтому неизбежен

6-й шаг - ручная привязка еще не привязанных марок.

Вот как-то так...Gustav

К сообщению приложен файл: Anatoliy45_3.xlsm (94.0 Kb)

МОИ: Ник, Tip box: 41001663842605

Сообщение отредактировал Gustav - Воскресенье, 24.06.2012, 11:18

Ответить

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

Схематично даю шаги решения, которые проделал я. Это больше даже себе узелок на память, нежели автору вопроса. Объяснять подробно ничего не буду, ибо как справедливо было замечено на другом форуме: в одном сообщении программировать на VBA не научить.

Прилагаемый к этому сообщению файл был получен на полном количестве строк оборудования и перед окончательным сохранением этот список на Листе1 был урезан до 2000 строк, чтобы уложиться в разрешенные к публикации на форуме 100 кб.

Итак, 1-й шаг - оценка объемов информации для обработки. Список оборудования - 6705 строк, список марок - 47 строк (подозреваю, далеко не полный). В процессе просмотра таблицы замечаю лишние пробелы между словами, поэтому

2-й шаг - сжатие пробелов соответствующей функцией в "Оборудовании" и в "Марках", результат - в колонках "Оборудование СЖПРОБЕЛЫ" и "Марка СЖПРОБЕЛЫ". В процессе просмотра таблицы таже было замечено большое количество повторяющихся строк оборудования, поэтому

3-й шаг - получение уникальных значений оборудования, при помощи расширенного фильтра по колонке Лист1!D ("Оборудование СЖПРОБЕЛЫ") и копировании отфильтрованных значений в колонку Лист3!A. Получилось 1022 уникальных значения из первоначальных 6705 строк. Что ж, сокращение внушительное, впору сказать: "Тыщу-то и глазками можно отсмотреть", но будем пытаться ужаться еще, поэтому

4-й шаг - написание макроса на VBA и его прогон. Макрос бежит по колонке Лист3!A ("Уникальные Оборудование СЖПРОБЕЛЫ"), в каждом значении оборудования ищет все значения марок из Лист1!E ("Марка СЖПРОБЕЛЫ"), при нахождении записывает конкретную марку напротив конкретного оборудования в соседнюю колонку Лист3!B ("Привязанные Марка СЖПРОБЕЛЫ").

5-й шаг - "перенос" значений марок в первоначальную таблицу, см. формулу в колонке Лист1!F ("Привязка Марки к Оборудованию") с использованием функций ИНДЕКС и ПОИСКПОЗ. Соотвественно, строки, где получился "0" (т.е. не получилась привязка) надо будет отфильтровать и попробовать привязать к ним марки вручную визуальным просмотром таблицы, поэтому неизбежен

6-й шаг - ручная привязка еще не привязанных марок.

Вот как-то так...

Автор - Gustav
Дата добавления - 24.06.2012 в 11:17

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

Группа: Пользователи

Ранг: Новичок

Сообщений: 11

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

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

как запускать прогон макроса по шагу 4?

Ответить

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

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

Ранг: Участник клуба

Сообщений: 2797

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

Замечаний: ±

начинал с Excel 4.0, видел 2.1

Quote (Anatoliy45)

как запускать прогон макроса по шагу 4?

Alt+F8 - макрос называется test - кнопка Выполнить

или

Alt+F11 - процедура test в Module1 - щелкнуть мышкой где-нибудь в середине - F5

МОИ: Ник, Tip box: 41001663842605

Ответить

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

Группа: Авторы

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

Сообщений: 120

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

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

Gustav, я чуток переделал твой макрос

К сообщению приложен файл: Anatoliy45_3-2-.7z (71.4 Kb)

E-mail: overseerpower@gmail.com
Skype: Bogdan_Rud
WMR: R166238237296

Сообщение отредактировал LightZ - Воскресенье, 24.06.2012, 16:01

Ответить

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

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

Ранг: Участник клуба

Сообщений: 2797

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

Замечаний: ±

начинал с Excel 4.0, видел 2.1

Quote (LightZ)

Gustav, я чуток переделал твой макрос

LightZ, нет предела совершенству, не возражаю, спасибо smile

smile

МОИ: Ник, Tip box: 41001663842605

Ответить

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

Группа: Авторы

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

Сообщений: 120

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

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

Gustav, у Вас слишком много ненужного в файле, есть такие функции как LCase и Trim
а с помощью двух массивов можно ускорить процесс выполнения.
вот смотрите:

[vba]

Code

Sub io()
     Dim i&, j&, li&
     Dim Arr(), Arr2()
     Dim tm!: tm = Timer
     Application.ScreenUpdating = False

     ReDim Arr(1 To [a2].CurrentRegion.Cells.Count, 1 To 2)
     ReDim Arr2(1 To Cells(Rows.Count, "g").End(xlUp).Row, 1)
     Arr = [a2].CurrentRegion.Value
     Arr2 = Range("g2:g" & Cells(Rows.Count, "g").End(xlUp).Row)

     For i = 1 To UBound(Arr)
         For j = 1 To UBound(Arr2)
             If Trim(LCase(Arr2(j, 1))) Like "*" & Trim(LCase(Arr(i, 1))) & "*" Then
                 Cells(j, "h").Value = Arr(i, 1)
                 Cells(j, "i").Value = Arr(i, 2)
                 li = li + 1
             End If
         Next
     Next

     Application.ScreenUpdating = True
     MsgBox Format((Timer - tm) / 24 / 60 / 60, "nn:ss") & "  мин:сек", _
     vbInformation, "Макрос выполнен за: "

     MsgBox li, vbInformation, "Найдено цен: "
End Sub

[/vba]

К сообщению приложен файл: 3793434.xlsm (50.3 Kb)

E-mail: overseerpower@gmail.com
Skype: Bogdan_Rud
WMR: R166238237296

Ответить

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

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

Ранг: Участник клуба

Сообщений: 3690

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

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

365

Тогда уж так можно ещё ускорить, добавив третий массив (если нужно сохранить уже записанные значения, то можно создавать его из диапазона листа, а не генерить новый):
[vba]

Code

Option Explicit

Sub io()
         Dim i&, j&, li&
         Dim Arr(), Arr2()
         Dim tm!: tm = Timer
         Application.ScreenUpdating = False

         ReDim Arr(1 To [a2].CurrentRegion.Cells.Count, 1 To 2)
         ReDim Arr2(1 To Cells(Rows.Count, "g").End(xlUp).Row, 1)
         Arr = [a2].CurrentRegion.Value
         Arr2 = Range("g2:g" & Cells(Rows.Count, "g").End(xlUp).Row)
         ReDim arr3(1 To UBound(Arr2), 1 To 2)
         For i = 1 To UBound(Arr)
             For j = 1 To UBound(Arr2)
                 If Application.Trim(UCase(Arr2(j, 1))) Like "*" & Application.Trim(UCase(Arr(i, 1))) & "*" Then
                     arr3(j, 1) = Arr(i, 1)
                     arr3(j, 2) = Arr(i, 2)
                     li = li + 1
                 End If
             Next
         Next

         [h2].Resize(UBound(arr3), 2) = arr3
         Application.ScreenUpdating = True
         MsgBox Format((Timer - tm) / 24 / 60 / 60, "nn:ss") & "  мин:сек", _
         vbInformation, "Макрос выполнен за: "

         MsgBox li, vbInformation, "Найдено цен: "
End Sub

[/vba]

Но правда из-за Application.Trim на 10 секунд замедлилось smile

smile

Но зато нашлось 2 упущенных совпадения!
И исправил несовпадение строк по позиции в коде LightZ.

P.S. Чтоб многократно не повторять ресурсоёмкие операции, можно сделать так (время сразу упало на 0):

[vba]

Code

Sub io2()
      Dim i&, j&, li&
      Dim Arr(), Arr2()
      Dim tm!: tm = Timer
      Application.ScreenUpdating = False

      ReDim Arr(1 To [a2].CurrentRegion.Cells.Count, 1 To 2)
      ReDim Arr2(1 To Cells(Rows.Count, "g").End(xlUp).Row, 1)
      Arr = [a2].CurrentRegion.Value
      Arr2 = Range("g2:g" & Cells(Rows.Count, "g").End(xlUp).Row)
      ReDim arr3(1 To UBound(Arr2), 1 To 2)

      For i = 1 To UBound(Arr)
          Arr(i, 1) = Application.Trim(UCase(Arr(i, 1)))
      Next
      For i = 1 To UBound(Arr2)
          Arr2(i, 1) = Application.Trim(UCase(Arr2(i, 1)))
      Next
      For i = 1 To UBound(Arr)
          For j = 1 To UBound(Arr2)
              If Arr2(j, 1) Like "*" & Arr(i, 1) & "*" Then
                  arr3(j, 1) = Arr(i, 1)
                  arr3(j, 2) = Arr(i, 2)
                  li = li + 1
              End If
          Next
      Next

      [h2].Resize(UBound(arr3), 2) = arr3
      Application.ScreenUpdating = True
      MsgBox Format((Timer - tm) / 24 / 60 / 60, "nn:ss") & "  мин:сек", _
             vbInformation, "Макрос выполнен за: "

      MsgBox li, vbInformation, "Найдено цен: "
End Sub

[/vba]

Тогда уж так можно ещё ускорить, добавив третий массив (если нужно сохранить уже записанные значения, то можно создавать его из диапазона листа, а не генерить новый):
[vba]

Code

Option Explicit

Sub io()
         Dim i&, j&, li&
         Dim Arr(), Arr2()
         Dim tm!: tm = Timer
         Application.ScreenUpdating = False

         ReDim Arr(1 To [a2].CurrentRegion.Cells.Count, 1 To 2)
         ReDim Arr2(1 To Cells(Rows.Count, "g").End(xlUp).Row, 1)
         Arr = [a2].CurrentRegion.Value
         Arr2 = Range("g2:g" & Cells(Rows.Count, "g").End(xlUp).Row)
         ReDim arr3(1 To UBound(Arr2), 1 To 2)
         For i = 1 To UBound(Arr)
             For j = 1 To UBound(Arr2)
                 If Application.Trim(UCase(Arr2(j, 1))) Like "*" & Application.Trim(UCase(Arr(i, 1))) & "*" Then
                     arr3(j, 1) = Arr(i, 1)
                     arr3(j, 2) = Arr(i, 2)
                     li = li + 1
                 End If
             Next
         Next

         [h2].Resize(UBound(arr3), 2) = arr3
         Application.ScreenUpdating = True
         MsgBox Format((Timer - tm) / 24 / 60 / 60, "nn:ss") & "  мин:сек", _
         vbInformation, "Макрос выполнен за: "

         MsgBox li, vbInformation, "Найдено цен: "
End Sub

[/vba]

Но правда из-за Application.Trim на 10 секунд замедлилось smile

smile

Но зато нашлось 2 упущенных совпадения!
И исправил несовпадение строк по позиции в коде LightZ.

P.S. Чтоб многократно не повторять ресурсоёмкие операции, можно сделать так (время сразу упало на 0):

[vba]

Code

Sub io2()
      Dim i&, j&, li&
      Dim Arr(), Arr2()
      Dim tm!: tm = Timer
      Application.ScreenUpdating = False

      ReDim Arr(1 To [a2].CurrentRegion.Cells.Count, 1 To 2)
      ReDim Arr2(1 To Cells(Rows.Count, "g").End(xlUp).Row, 1)
      Arr = [a2].CurrentRegion.Value
      Arr2 = Range("g2:g" & Cells(Rows.Count, "g").End(xlUp).Row)
      ReDim arr3(1 To UBound(Arr2), 1 To 2)

      For i = 1 To UBound(Arr)
          Arr(i, 1) = Application.Trim(UCase(Arr(i, 1)))
      Next
      For i = 1 To UBound(Arr2)
          Arr2(i, 1) = Application.Trim(UCase(Arr2(i, 1)))
      Next
      For i = 1 To UBound(Arr)
          For j = 1 To UBound(Arr2)
              If Arr2(j, 1) Like "*" & Arr(i, 1) & "*" Then
                  arr3(j, 1) = Arr(i, 1)
                  arr3(j, 2) = Arr(i, 2)
                  li = li + 1
              End If
          Next
      Next

      [h2].Resize(UBound(arr3), 2) = arr3
      Application.ScreenUpdating = True
      MsgBox Format((Timer - tm) / 24 / 60 / 60, "nn:ss") & "  мин:сек", _
             vbInformation, "Макрос выполнен за: "

      MsgBox li, vbInformation, "Найдено цен: "
End Sub

[/vba]Hugo

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

СообщениеТогда уж так можно ещё ускорить, добавив третий массив (если нужно сохранить уже записанные значения, то можно создавать его из диапазона листа, а не генерить новый):
[vba]

Code

Option Explicit

Sub io()
         Dim i&, j&, li&
         Dim Arr(), Arr2()
         Dim tm!: tm = Timer
         Application.ScreenUpdating = False

         ReDim Arr(1 To [a2].CurrentRegion.Cells.Count, 1 To 2)
         ReDim Arr2(1 To Cells(Rows.Count, "g").End(xlUp).Row, 1)
         Arr = [a2].CurrentRegion.Value
         Arr2 = Range("g2:g" & Cells(Rows.Count, "g").End(xlUp).Row)
         ReDim arr3(1 To UBound(Arr2), 1 To 2)
         For i = 1 To UBound(Arr)
             For j = 1 To UBound(Arr2)
                 If Application.Trim(UCase(Arr2(j, 1))) Like "*" & Application.Trim(UCase(Arr(i, 1))) & "*" Then
                     arr3(j, 1) = Arr(i, 1)
                     arr3(j, 2) = Arr(i, 2)
                     li = li + 1
                 End If
             Next
         Next

         [h2].Resize(UBound(arr3), 2) = arr3
         Application.ScreenUpdating = True
         MsgBox Format((Timer - tm) / 24 / 60 / 60, "nn:ss") & "  мин:сек", _
         vbInformation, "Макрос выполнен за: "

         MsgBox li, vbInformation, "Найдено цен: "
End Sub

[/vba]

Но правда из-за Application.Trim на 10 секунд замедлилось smile

smile

Но зато нашлось 2 упущенных совпадения!
И исправил несовпадение строк по позиции в коде LightZ.

P.S. Чтоб многократно не повторять ресурсоёмкие операции, можно сделать так (время сразу упало на 0):

[vba]

Code

Sub io2()
      Dim i&, j&, li&
      Dim Arr(), Arr2()
      Dim tm!: tm = Timer
      Application.ScreenUpdating = False

      ReDim Arr(1 To [a2].CurrentRegion.Cells.Count, 1 To 2)
      ReDim Arr2(1 To Cells(Rows.Count, "g").End(xlUp).Row, 1)
      Arr = [a2].CurrentRegion.Value
      Arr2 = Range("g2:g" & Cells(Rows.Count, "g").End(xlUp).Row)
      ReDim arr3(1 To UBound(Arr2), 1 To 2)

      For i = 1 To UBound(Arr)
          Arr(i, 1) = Application.Trim(UCase(Arr(i, 1)))
      Next
      For i = 1 To UBound(Arr2)
          Arr2(i, 1) = Application.Trim(UCase(Arr2(i, 1)))
      Next
      For i = 1 To UBound(Arr)
          For j = 1 To UBound(Arr2)
              If Arr2(j, 1) Like "*" & Arr(i, 1) & "*" Then
                  arr3(j, 1) = Arr(i, 1)
                  arr3(j, 2) = Arr(i, 2)
                  li = li + 1
              End If
          Next
      Next

      [h2].Resize(UBound(arr3), 2) = arr3
      Application.ScreenUpdating = True
      MsgBox Format((Timer - tm) / 24 / 60 / 60, "nn:ss") & "  мин:сек", _
             vbInformation, "Макрос выполнен за: "

      MsgBox li, vbInformation, "Найдено цен: "
End Sub

[/vba]

Автор - Hugo
Дата добавления - 24.06.2012 в 17:29

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

Группа: Авторы

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

Сообщений: 120

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

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

Да, точно, упустил application
Можно обойтись без 3го массива, т.к. с ним на 1сек медленней smile

smile

E-mail: overseerpower@gmail.com
Skype: Bogdan_Rud
WMR: R166238237296

Ответить

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

Группа: Авторы

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

Сообщений: 120

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

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

Quote (Hugo)

И исправил несовпадение строк по позиции в коде LightZ.

Какие?

E-mail: overseerpower@gmail.com
Skype: Bogdan_Rud
WMR: R166238237296

Ответить

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

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

Ранг: Участник клуба

Сообщений: 3690

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

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

365

Согласен, на таком объёме можно и без него - всего-то 31 совпадение на лист прописать smile

smile

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

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

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

Ранг: Участник клуба

Сообщений: 3690

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

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

365

Quote (LightZ)

Какие?

[vba]

Code

Arr2 = Range("g2....
Cells(j, "h").Value =....

[/vba]

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

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

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

Ранг: Участник клуба

Сообщений: 2797

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

Замечаний: ±

начинал с Excel 4.0, видел 2.1

Quote (LightZ)

Gustav, у Вас слишком много ненужного в файле, есть такие функции как LCase и Trim

Я же сказал, что не возражаю против улучшений. Да что там "не возражаю", я их искренне приветствую! smile

smile

У меня формулы, возможно избыточные (лишние, "ненужные"), возникали в ходе решения - хоть какого-то первого наброска решения. Зато с их помощью я по ходу видел промежуточные результаты и мог на их основе выбирать дальнейшее направление изысканий. Я не собирался оптимизировать свое решение. Я и так потратил на него (и на словесное оформление) пару своих кровных воскресных часов, за которые мне пока даже не сказали элементарного "спасибо". Ну да Бог с ним, если "заказчику" подходят мои рассуждения, то я рад. Если нет, то, как я уже сказал - узелок мне (а может и кому-то еще ) на память.

Про LCase и Тrim я, как ни странно, знаю. Даже знаю, что результат работы Trim не совпадает с результатом СЖПРОБЕЛЫ - смотрите в окне отладки:
[vba]

Code

? Trim("   Сжаты    ли     пробелы?   ")
Сжаты    ли     пробелы?

[a1].Formula = "=TRIM(""   Сжаты    ли     пробелы?   "")"
? [a1].Value
Сжаты ли пробелы?

[/vba]

МОИ: Ник, Tip box: 41001663842605

Ответить

Сообщение

Quote (LightZ)

Gustav, у Вас слишком много ненужного в файле, есть такие функции как LCase и Trim

Я же сказал, что не возражаю против улучшений. Да что там "не возражаю", я их искренне приветствую! smile

smile

У меня формулы, возможно избыточные (лишние, "ненужные"), возникали в ходе решения - хоть какого-то первого наброска решения. Зато с их помощью я по ходу видел промежуточные результаты и мог на их основе выбирать дальнейшее направление изысканий. Я не собирался оптимизировать свое решение. Я и так потратил на него (и на словесное оформление) пару своих кровных воскресных часов, за которые мне пока даже не сказали элементарного "спасибо". Ну да Бог с ним, если "заказчику" подходят мои рассуждения, то я рад. Если нет, то, как я уже сказал - узелок мне (а может и кому-то еще ) на память.

Про LCase и Тrim я, как ни странно, знаю. Даже знаю, что результат работы Trim не совпадает с результатом СЖПРОБЕЛЫ - смотрите в окне отладки:
[vba]

Code

? Trim("   Сжаты    ли     пробелы?   ")
Сжаты    ли     пробелы?

[a1].Formula = "=TRIM(""   Сжаты    ли     пробелы?   "")"
? [a1].Value
Сжаты ли пробелы?

[/vba]

Автор - Gustav
Дата добавления - 24.06.2012 в 17:47

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

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

Ранг: Участник клуба

Сообщений: 3690

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

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

365

Gustav, на то есть Application.Trim() smile

smile

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

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

Группа: Авторы

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

Сообщений: 120

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

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

Hugo, а что собственно неправильно? smile

smile

[vba]

Code

Arr2 = Range("g2:g" & Cells(Rows.Count, "g").End(xlUp).Row)

[/vba]
Заносим данные в массив со столбца G

[vba]

Code

Cells(j, "h").Value = Arr(i, 1)

[/vba]
Выводим в столбец H данные с первого столбца массива

E-mail: overseerpower@gmail.com
Skype: Bogdan_Rud
WMR: R166238237296

Ответить

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

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

Ранг: Участник клуба

Сообщений: 3690

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

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

365

LightZ, посмотри внимательно - массив берётся от второй строки, а результат выгружается точно по индексу массива.
И на планете в файле тоже сдвиг - специально скачал глянул, там даже код не выполнял, там уже готовый результат со сдвигом.

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

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

Группа: Авторы

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

Сообщений: 120

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

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

Quote (Gustav)

что результат работы Trim не совпадает с результатом СЖПРОБЕЛЫ

Gustav, попробуйте запустить этот макрос, поймете разницу

[vba]

Code

Sub io()
     With Cells(1, 1)
         .Value = "    s    s   "
         Cells(1, 2).Value = Application.Trim(.Value)
         MsgBox Len(Cells(1, 2))
         Cells(1, 2).Value = Trim(.Value)
         MsgBox Len(Cells(1, 2))
     End With
End Sub

[/vba]

Hugo, а всё, понял. Просто изначально делал без заголовка столбцов smile

smile

E-mail: overseerpower@gmail.com
Skype: Bogdan_Rud
WMR: R166238237296

Ответить

Работа с xls - сравнение столбцов, с примерами в ТЗ

Страница 1 из 3
1
2
3
»

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