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

@IIPAIIOP · Регистрация: 05.02.2013

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

Здравствуйте!
Подскажите, как в массив добавить внесение не только по 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

Заранее благодарен!!

@IIPAIIOP · 27.03.2013, 00:40 **[ТС]**

получилось раскинуть на кучки, только так, что на каждом листе критерии и для них результаты на разных листах.
в сумме получилось 9 листов. теперь осталось собрать это все на 10 лист,на котором будут результаты отдельно по фирме1 и по фирме2, подскажите как их собрать, максимум, что у меня получилось, так это сливать все на один лист с листа 6-9, где результаты.

Добавлено через 37 минут
а объединяю вот так

Visual Basic
1
2
3
4
5
6
For i = 5 To ThisWorkbook.Worksheets.Count
         If ThisWorkbook.Worksheets(i).Name <> "Лист10" Then
          ThisWorkbook.Worksheets(i).Range("A1:" + ThisWorkbook.Worksheets(i).Cells.SpecialCells(xlCellTypeLastCell).Address).Copy Destination:= _
    ThisWorkbook.Worksheets("Лист10").Cells(ThisWorkbook.Worksheets("Лист10").Cells.SpecialCells(xlCellTypeLastCell).Row, 1)
          End If
      Next i

@IIPAIIOP · 28.03.2013, 09:04 **[ТС]**

Visual Basic
1
2
3
4
5
6
For i = 5 To ThisWorkbook.Worksheets.Count
         If ThisWorkbook.Worksheets(i).Name <> "Лист10" Then
          ThisWorkbook.Worksheets(i).Range("A1:" + ThisWorkbook.Worksheets(i).Cells.SpecialCells(xlCellTypeLastCell).Address).Copy Destination:= _
    ThisWorkbook.Worksheets("Лист10").Cells(ThisWorkbook.Worksheets("Лист10").Cells.SpecialCells(xlCellTypeLastCell).Row, 1)
          End If
      Next i

У меня что-то с копированием не так. т.е. лист 6 это 1й с результатом в диапазоне от 1-50 7 лист 2 результат от 569-до 589 а след вообще за тыщу в чем косяк ?

@Hugo121 · 28.03.2013, 13:58

Т.к. в целом мне задача так и не понятна - я на основной вопрос ответить не могу.
А по этому частному - вероятно ошибка в использовании xlCellTypeLastCell.
Хотя конечно тоже задача в деталях не ясна

@IIPAIIOP · 28.03.2013, 15:43 **[ТС]**

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

Т.к. в целом мне задача так и не понятна - я на основной вопрос ответить не могу.
А по этому частному - вероятно ошибка в использовании xlCellTypeLastCell.
Хотя конечно тоже задача в деталях не ясна

задача собрать информацию с листа6 по9 включительно. на 10 лист

Добавлено через 2 минуты
оФФтоп: у меня есть ячейка в столбце, где номер телефона записан ввиду =796788-33-222, соотвеств. он превращается в формулу как мне извлечь "=" в цикле и как ? уже 4 часа ковыряюсь понять не могу.
Спасибо.

@Hugo121 · 28.03.2013, 15:53

Ctrl+H -> заменить = на ничего.

@IIPAIIOP · 28.03.2013, 16:07 **[ТС]**

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

Ctrl+H -> заменить = на ничего.

Первое, что сделал.
он = не находит )))))

@IIPAIIOP · 01.04.2013, 09:50 **[ТС]**

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

А по этому частному - вероятно ошибка в использовании xlCellTypeLastCell.

А чем предложите заменить ?
Еще раз повторюсь, я собираю все данные с листов 6 по 9.

@Hugo121 · 01.04.2013, 18:06

Ну обычно используют

Visual Basic
1
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row

Далее берут диапазон от начала до этого значения строки.
Или можно использовать currentregion - смотря по задаче/данным.

Новые блоги и статьи Все статьи Все блоги /
Nekobox - outbounds[0].transport: unknown transport type: raw damix 01.10.2026 Фикс ошибки Правым кликом по серверу -> отладочная информация -> edit Заменить "net": "raw", на "net": "tcp", Нажать кнопку reload.	Программный домашний кинотеатр 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 и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .	Программа опроса у.з. расходомера SLS-720F Argus19 02.09.2026 Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .	Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0. Maks 31.08.2026 При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	28.03.2013, 13:58
	Т.к. в целом мне задача так и не понятна - я на основной вопрос ответить не могу. А по этому частному - вероятно ошибка в использовании xlCellTypeLastCell. Хотя конечно тоже задача в деталях не ясна 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	28.03.2013, 15:53
	Ctrl+H -> заменить = на ничего. 0