Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.90/10: Рейтинг темы: голосов - 10, средняя оценка - 4.90
IIPAIIOP
0 / 0 / 1
Регистрация: 05.02.2013
Сообщений: 150
1

Как в массив добавить внесение не только по 4 символам, но и по 2,3,5 и 7?

20.03.2013, 13:55. Просмотров 1833. Ответов 27
Метки нет (Все метки)

Здравствуйте!
Подскажите, как в массив добавить внесение не только по 4 символам, но и по 2,3,5 и 7
Ниже привожу массив
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 For y = BaseStart.Row To BaseStart.End(xlDown).Row
     ArBase(n) = Left$(LTrim$(Sheets("Лист2").Cells(y, BaseStart.Column)), 4)
       'ArBase(n) = Left$(LTrim$(Sheets("Лист2").Cells(y, BaseStart.Column)), 3)
        n = n + 1
    Next y
 
ReDim Preserve ArList1(1 To 1)
      n = 0
      For y = CStart.Row To Sheets("Лист1").Cells(Rows.Count, x).End(xlUp).Row 'по всем кодам
        tmp = Trim$(Sheets("Лист1").Cells(y, x))
        tmp = Add_Ziro(tmp, 4) 'дописываем нули, если знаков < 7 (кол-во знаков = 4)
       ' tmp = Add_Ziro(tmp, 3)
        For nn = 1 To n 'ищем и записываем в массив уникальные коды
          If ArList1(nn) = tmp Then Exit For
        Next
Visual Basic
1
2
3
4
5
6
7
8
9
Private Function Add_Ziro$(ByVal tmp$, Razr%) 'Razr - сколько должно получится
    If Len(tmp) > 2 Then 'защита от ошибок
          'берем первые 4 символа без пробела (лист1)
          'и дописываем вначало строки нули, если кол-во разрядов < 7
          tmp = String(7 - Len(tmp), "0") & Left$(tmp, Razr - (7 - Len(tmp))) '7 - кол-во разрядов, 4 - кол-во нужных симв.
          Else: tmp = Left$(tmp, 2) 'если разрядов <=2, берем абы что-нибуть
    End If
    Add_Ziro = tmp
End Function
Заранее благодарен!!
0
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
20.03.2013, 13:55
Ответы с готовыми решениями:

Как считать из файла текст по символам в массив php?
Всем привет! У меня есть файл &quot;proba2.txt&quot;, в нем некий набор символов, например такой: &amp;1?1@1...

Значение Chr только символам 0-9 a-z A-Z
Допустим есть такой код: Chr(48 + P Mod 75) P - переменная Как сделать так, чтобы Chr...

Чтение строк, разобрать по спец.символам, добавить в DataGridView
Добрый день! Помогите разобраться. Есть текстовый файл: И надо разобрать и добавить в...

Ссылка на документ на компьтере только по первым символам в названии
Здравствуйте! Я не специалист в программировании, поэтому был бы очень рад вашей помощи по...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
27
Казанский
14911 / 6312 / 1721
Регистрация: 24.09.2011
Сообщений: 9,977
20.03.2013, 14:06 2
Выложите файл и расскажите, какова конечная цель этих действий.
Получение "уникальных кодов" лучше производить с помощью коллекции или словаря.
0
IIPAIIOP
0 / 0 / 1
Регистрация: 05.02.2013
Сообщений: 150
20.03.2013, 15:07  [ТС] 3
Макрос сравнивает коды с разных листов и выдает результат.
В этом варианте он загружает в массив только первые 4 символа строки.
Необходимо, чтобы в массив загружалось 4,2,3,7 символов и по ним шло сравнение.
и затем эти коды сравнивались.
Файл прилагаю
0
Вложения
Тип файла: rar непонятнома12.rar (112.4 Кб, 16 просмотров)
IIPAIIOP
0 / 0 / 1
Регистрация: 05.02.2013
Сообщений: 150
21.03.2013, 13:18  [ТС] 4
Уважаемые, есть какая-нибудь информация ? путного придумать не получается
0
21.03.2013, 13:18
Hugo121
6476 / 2530 / 454
Регистрация: 19.10.2012
Сообщений: 7,600
21.03.2013, 13:32 5
Нету.
Загрузил, посмотрел - ничего не понял. Решать шарады желания нет.
Расскажите подробно задачу, словами - может и придумаем решение.
0
IIPAIIOP
0 / 0 / 1
Регистрация: 05.02.2013
Сообщений: 150
21.03.2013, 15:18  [ТС] 6
Visual Basic
1
2
3
4
5
 For y = BaseStart.Row To BaseStart.End(xlDown).Row
     ArBase(n) = Left$(LTrim$(Sheets("Лист2").Cells(y, BaseStart.Column)), 4)
       'ArBase(n) = Left$(LTrim$(Sheets("Лист2").Cells(y, BaseStart.Column)), 3)
        n = n + 1
    Next y
Есть массив, в который загружаются коды (первые 4 символа.),( всего их 7 в коде)
необходимо так же чтобы в этот самый массив загружались коды по 2 первых символа, 3 и 7 символов.
А потом сравнивались с информацией на листе 2 столб Е. и выходили в результат на лист 3.
0
Hugo121
6476 / 2530 / 454
Регистрация: 19.10.2012
Сообщений: 7,600
21.03.2013, 15:44 7
Загружайте не в массив, а в словарь (или коллекцию) - сравнивать будет и легче, и быстрее.
А задачу в целом так и не объяснили.
0
IIPAIIOP
0 / 0 / 1
Регистрация: 05.02.2013
Сообщений: 150
21.03.2013, 15:49  [ТС] 8
Расскажите, что есть словарь или коллекция ?
0
Hugo121
6476 / 2530 / 454
Регистрация: 19.10.2012
Сообщений: 7,600
21.03.2013, 17:17 9
Расскажу своими словами, а "научное" описание несложно нагуглить (образцов кода на форуме уже тоже много).
Scripting.Dictionary или Collection есть некий безразмерный объект, где могут храниться значения. В словаре уникальные, в коллекции не только (т.е. есть некоторые отличия).
Причём проверка наличия значения в этих объектах происходит практически мнгновенно ибез всяких внешних циклов.
Например нам нужно сравнить два списка - одним циклом по одному списку заносим значения в словарь, затем одним циклом по второму списку получаем информацию - всё быстро и коротким кодом.
В Вашем случае вероятно одним циклом по одному списку можно в словарь занести эти 4/2/3/7 символов, затем одним циклом по второму списку проверить, нет ли в словаре текущих 4/2/3/7 символов. Если конечно нужно это - Вы так и не рассказали, что именно нужно.
0
IIPAIIOP
0 / 0 / 1
Регистрация: 05.02.2013
Сообщений: 150
21.03.2013, 22:47  [ТС] 10
Да, мне так и нужно, проверить на совпадение коды с листа 1 с листом 2 и вывести на лист3 совпадающие.
т.е. есть код 1520111 на листе 1(на котором критерии) из этого кода берутся первые 2,3,4,7 символа и сравниваются с листом 2 на котором код 1530000 (далее он проверяется на искл из листа 1) соответственно если его в искл нет он переносится на лист 3. На выходе получаться дубли, которые будут по другому алгоритму фильтроваться
0
Hugo121
6476 / 2530 / 454
Регистрация: 19.10.2012
Сообщений: 7,600
22.03.2013, 10:02 11
Не понятен смысл - зачем отбирать по 3,4,7, если текущее значение уже будет отобрано по 2?
Т.е. из 1520111 получаем как критерии 15, 152, 1520 и 1520111, далее любое значение если не проходит по 15, то по остальным критериям можно уже и не проверять.
Или же раскладываем фильтруемых в 4 кучки - сперва по совпадению по 7, далее по убывающей?
Тогда создаём 4 словаря, затем в таком порядке и проверяем.

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

Добавлено через 10 часов 44 минуты
Нет, не нужно 4 словаря - достаточно одного. Раскладывать по кучкам можно в зависимости от проверяемого критерия.
0
IIPAIIOP
0 / 0 / 1
Регистрация: 05.02.2013
Сообщений: 150
22.03.2013, 13:29  [ТС] 12
общая база в которой находится инф. находится на листе 2. На листе 1 в столбце "А" находятся коды (критерии) которые нужны и здесь же на листе 1 в столбце 2 находятся исключения. Т.е. есть групповые коды 1500000( в которые входят 1520111 и др.) и для них есть искл 1520211 если на листе 2 есть этот код из искл то он не будет переносится в общ результат. Ниже код который загружает в массив и проверяет
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
ReDim ArBase(1 To Range(BaseStart, BaseStart.End(xlDown)).Cells.Count)
    ReDim Exclude(1 To 1)
    
    '=== сгружаем в массив все ОКДП в базе ===
    For y = BaseStart.Row To BaseStart.End(xlDown).Row
        ArBase(n) = Left$(LTrim$(Sheets("Лист2").Cells(y, BaseStart.Column)), 2)
        n = n + 1
    Next y
    
    '=== по всем фирмам ===
    For x = 1 To CStart.Offset(-1).End(xlToRight).Column Step 2 'кол-во фирм = кол-во столбцов /2
      Sheets("Лист4").Cells(yDest, 1) = "Фирма" & x \ 2 + 1 'шапка
      Sheets("Лист4").Cells(yDest, 2) = Sheets("Лист1").Cells(CStart.Row, x).Offset(-4, 1) 'Firm
      Sheets("Лист4").Cells(yDest, 3) = "почта"
      Sheets("Лист4").Cells(yDest, 4) = Sheets("Лист1").Cells(CStart.Row, x).Offset(-2, 1) 'Mail
      Sheets("Лист4").Cells(yDest + 1, 1) = "Доброго дня, " & Sheets("Лист1").Cells(CStart.Row, x).Offset(-3, 1) & "!" 'Face
      
      '=== запись уникальных входящих ОКДП-групп в массив ===
      ReDim Preserve ArList1(1 To 1)
      n = 0
      For y = CStart.Row To Sheets("Лист1").Cells(Rows.Count, x).End(xlUp).Row 'по всем окдп
        tmp = Trim$(Sheets("Лист1").Cells(y, x))
        tmp = Add_Ziro(tmp, 2) 'дописываем нули, если знаков < 7 (кол-во знаков = 4)
        For nn = 1 To n 'ищем и записываем в массив уникальные окдп
          If ArList1(nn) = tmp Then Exit For
        Next
        If nn = n + 1 Then n = n + 1: ReDim Preserve ArList1(1 To n): ArList1(n) = tmp
      Next y
      
      '=== запись исключений ОКДП в массив
      ReDim Preserve Exclude(1 To 1)
      n = 9 'номер строки, где начинаются исключения
      Do While Len(Sheets("Лист1").Cells(n, x + 1)) <> 0
        If Exclude(UBound(Exclude)) <> vbNullString Then ReDim Preserve Exclude(1 To UBound(Exclude) + 1)
        tmp = Trim(Sheets("Лист1").Cells(n, x + 1))
        tmp = Add_Ziro(tmp, 7) 'дописываем нули, если знаков < 7 (кол-во знаков = 7)
        Exclude(UBound(Exclude)) = tmp
        n = n + 1
      Loop
    
      '=== сравнение массивов ОКДП, в т.ч. исключения ===
      For nn = 1 To UBound(ArList1)
        For n = 1 To UBound(ArBase) 'по всем окдп базы (из массива)
          If ArBase(n) = ArList1(nn) Then 'сравниваем окдп двух массивов (входящие и базу)
            'проверка на исключения
            For nEx = 1 To UBound(Exclude)
              If InStr(Sheets("Лист2").Cells(n, 6), Exclude(nEx)) Then Exit For
            Next nEx
            If nEx = UBound(Exclude) + 1 Then 'если не было исключений
              If Success = False Then 'если не было ни одной записи
                Success = True
                Sheets("Лист4").Cells(yDest + 2, 1) = Ex 'дописываем шапку
                yDest = yDest + 3 'через 3 строки
              End If
              Range(Sheets("Лист2").Cells(n, 1), Sheets("Лист2").Cells(n, 10)).Copy Sheets("Лист4").Range("A" & yDest)
              yDest = yDest + 1 'через 1 строку
            End If
          End If
        Next n
      Next nn
0
Hugo121
6476 / 2530 / 454
Регистрация: 19.10.2012
Сообщений: 7,600
22.03.2013, 13:44 13
Нет, я в код вникать с целью понять задачу не буду - времени жалко (да и нет его, работаю...).
Лучше продолжайте рассказывать - вот есть список кодов и исключений, что дальше? Где ищем совпадения, по каким параметрам, что делаем по результату?
Ведь если отбирать по двум первым цифрам, то достаточно списка 11, 15, 94, зачем там 20 номеров? По исключениям тоже есть вопрос - именно такие номера, или все в десятке этого номера?
0
IIPAIIOP
0 / 0 / 1
Регистрация: 05.02.2013
Сообщений: 150
25.03.2013, 00:43  [ТС] 14
Цитата Сообщение от Hugo121 Посмотреть сообщение
Нет, я в код вникать с целью понять задачу не буду - времени жалко (да и нет его, работаю...).
Лучше продолжайте рассказывать - вот есть список кодов и исключений, что дальше? Где ищем совпадения, по каким параметрам, что делаем по результату?
Ведь если отбирать по двум первым цифрам, то достаточно списка 11, 15, 94, зачем там 20 номеров? По исключениям тоже есть вопрос - именно такие номера, или все в десятке этого номера?
Алгоритм следующий на данный момент.
берется 4 первых символа сравниваются с листом 2 если они совпадают то проверяются на искл(искл это полностью все 7 символов кода) и далее результат переносится на лист 3. теперь же нужно увеличить, как я писал выше. можно конечно сделать разными макросами, но это убого.
0
Dragokas
Эксперт WindowsАвтор FAQ
17127 / 7181 / 864
Регистрация: 25.12.2011
Сообщений: 10,971
Записей в блоге: 16
25.03.2013, 15:01 15
О, узнаю свой код. А предыдущей макрописатель что ушел в отпуск?

Если выложите книгу в формате Excel 2003, может и помогу разобраться.
И неплохо бы еще ссылку на старую тему в этом разделе.
0
IIPAIIOP
0 / 0 / 1
Регистрация: 05.02.2013
Сообщений: 150
25.03.2013, 15:08  [ТС] 16
Dragokas, Доброго дня. Файл во вложении )
0
Вложения
Тип файла: zip непонятнома12.zip (80.8 Кб, 5 просмотров)
Hugo121
6476 / 2530 / 454
Регистрация: 19.10.2012
Сообщений: 7,600
25.03.2013, 17:15 17
Увеличить...
Вот зачем увеличивать, если по описанию достаточно заменить 4 на 2?
0
IIPAIIOP
0 / 0 / 1
Регистрация: 05.02.2013
Сообщений: 150
26.03.2013, 12:58  [ТС] 18
Ссылка на предыдущую тему Необходимо написать цикл для поиска

Добавлено через 1 час 36 минут
Цитата Сообщение от Hugo121 Посмотреть сообщение
Не понятен смысл - зачем отбирать по 3,4,7, если текущее значение уже будет отобрано по 2?
Таковы критерии...

Добавлено через 38 минут
чтобы можно было найти только те которые соответствуют 2м те которые соответствуют 3,4,7
т.е. есть в перечне 1500000 и 1680000 нужно чтобы он работал только у того у кого 2 символа
если 1680000 то с 3мя символами. и там далее с 4мя и полностью с 7мю
0
Hugo121
6476 / 2530 / 454
Регистрация: 19.10.2012
Сообщений: 7,600
26.03.2013, 13:27 19
Т.е. всё же нужно на 4 кучки разложить? Куда?
Понимаете - в деталях ничего не понятно, соотв. писать код нет смысла (я могу сделать так, как я предполагаю - но ведь Вам нужно другое...).
0
IIPAIIOP
0 / 0 / 1
Регистрация: 05.02.2013
Сообщений: 150
26.03.2013, 14:11  [ТС] 20
Да можно и 4 кучки, т.е. один лист по 2, второй по 3, третий по 4 и последний по 7, потом клеить это в какой-нибудь лист к примеру 7.
Но тут вопрос это по одной фирме, а как если будет еще одна. Значится на листе 1 будет подряд куча фирм.
0
26.03.2013, 14:11
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.