Добрый день! Произвожу копирование значений через массивы. Причем массив задан как string.
[vba]
Код
.................... Dim Tablica() As String .....................
For Each sht In ActiveWorkbook.Worksheets If sht.Index <> 1 Then i1 = 0 'скидываем на первую строку For i = Shapka + 1 To i_n(sht.Index - 1) i1 = i1 + 1 For j = 1 To j1 Tablica(sht.Index - 1, i1, j) = sht.Cells(i, j) Next j ' MsgBox (Tablica(sht.Index - 1, i1, j1)) Next i End If Next sht ............................
[/vba] В ячейках есть значения аля "077342". При копировании получаю "77342", то есть "0" съедается. Можно ли как-то сохранить этот нолик? Желательно не исправляя формат ячеек с общего на текстовый.
Добрый день! Произвожу копирование значений через массивы. Причем массив задан как string.
[vba]
Код
.................... Dim Tablica() As String .....................
For Each sht In ActiveWorkbook.Worksheets If sht.Index <> 1 Then i1 = 0 'скидываем на первую строку For i = Shapka + 1 To i_n(sht.Index - 1) i1 = i1 + 1 For j = 1 To j1 Tablica(sht.Index - 1, i1, j) = sht.Cells(i, j) Next j ' MsgBox (Tablica(sht.Index - 1, i1, j1)) Next i End If Next sht ............................
[/vba] В ячейках есть значения аля "077342". При копировании получаю "77342", то есть "0" съедается. Можно ли как-то сохранить этот нолик? Желательно не исправляя формат ячеек с общего на текстовый.Roman777
_Boroda_, Попробовал ваш вариант, не работает. Файл пример приложу и код весь прикручу.
[vba]
Код
Sub КопированиеНаЛистВсехЛистов_Через_Массивы_Гипперссылки_индивидуальные() ' можно добавить гиперссылки через диапазон, используя массив i_n() Dim sht As Worksheet Dim cell As Range Dim j As Long, k As Long, i As Long, i1 As Long, i2 As Long Dim j1 As Integer Dim Razdel As String, NameSht As String Dim i_n() As Long Dim Tablica() Dim shtName() As String Dim t As Long Time_1 = Timer Sheets(1).Select NameSht = "Данные по книге" Razdel = "Розетки и выключатели." Shapka = 2 ' номер строки шапки, за которой следует сама таблица j1 = InputBox("Введите номер столбца, до которого мы собираемся записывать данные", "Номер столбца", "8") If Sheets(1).Name = NameSht Then Application.DisplayAlerts = False Sheets(1).Delete Application.DisplayAlerts = True End If Sheets(1).Select Sheets.Add Before:=ActiveSheet Sheets(1).Name = NameSht Sheets(1).Cells.ClearContents Sheets(2).Cells(2, 1).Resize(, j1).Copy Sheets(1).Cells(1, 1) Application.ScreenUpdating = False k_n = Worksheets.Count - 1 ReDim i_n(k_n) ReDim shtName(k_n) '________________________создание массива кол-ва строк на каждом листе______начало For Each sht In ActiveWorkbook.Worksheets If sht.Index <> 1 Then i_n(sht.Index - 1) = sht.Cells(Rows.Count, 3).End(xlUp).Row shtName(sht.Index - 1) = sht.Name If i_nn < i_n(sht.Index - 1) Then i_nn = i_n(sht.Index - 1) End If End If Next sht
'________________________создание массива кол-ва строк на каждом листе______конец ReDim Tablica(Worksheets.Count - 1, i_nn, j1) For Each sht In ActiveWorkbook.Worksheets If sht.Index <> 1 Then i1 = 0 'скидываем на первую строку For i = Shapka + 1 To i_n(sht.Index - 1) i1 = i1 + 1 For j = 1 To j1 Tablica(sht.Index - 1, i1, j) = sht.Cells(i, j) Next j ' MsgBox (Tablica(sht.Index - 1, i1, j1)) Next i End If Next sht i2 = 1 t = 2 For k = 1 To k_n For i = 1 To i_n(k) - Shapka i2 = i2 + 1 For j = 1 To j1 Worksheets(1).Cells(i2, j) = Tablica(k, i, j) Next j Set cell = Worksheets(1).Cells(i2, j1 + 1) Worksheets(1).Hyperlinks.Add Anchor:=cell, Address:="", _ SubAddress:="'" & shtName(k) & "'" & "!A" & Shapka + i cell.Formula = shtName(k) Next i Set cell = Worksheets(k + 1).Cells(1, 7) Worksheets(1).Hyperlinks.Add Anchor:=cell, Address:="", _ SubAddress:="'" & Worksheets(1).Name & "'" & "!A" & t cell.Formula = Worksheets(1).Name t = i2 + 1 With Worksheets(k + 1).Cells(1, 7).Font .Name = "Times New Roman" .Size = 12 .Bold = True .Italic = True End With With Worksheets(k + 1).Cells(1, 7) .WrapText = True End With Next k Application.ScreenUpdating = True Cells.RowHeight = 15 Rows(1).RowHeight = 55 Time_ = Time_1 - Timer Time_delta = Format(Time_ / 24 / 60 / 60, "hh\ч mm\м ss\с") MsgBox ("Выполненно за " & Time_delta) End Sub
[/vba]
_Boroda_, Попробовал ваш вариант, не работает. Файл пример приложу и код весь прикручу.
[vba]
Код
Sub КопированиеНаЛистВсехЛистов_Через_Массивы_Гипперссылки_индивидуальные() ' можно добавить гиперссылки через диапазон, используя массив i_n() Dim sht As Worksheet Dim cell As Range Dim j As Long, k As Long, i As Long, i1 As Long, i2 As Long Dim j1 As Integer Dim Razdel As String, NameSht As String Dim i_n() As Long Dim Tablica() Dim shtName() As String Dim t As Long Time_1 = Timer Sheets(1).Select NameSht = "Данные по книге" Razdel = "Розетки и выключатели." Shapka = 2 ' номер строки шапки, за которой следует сама таблица j1 = InputBox("Введите номер столбца, до которого мы собираемся записывать данные", "Номер столбца", "8") If Sheets(1).Name = NameSht Then Application.DisplayAlerts = False Sheets(1).Delete Application.DisplayAlerts = True End If Sheets(1).Select Sheets.Add Before:=ActiveSheet Sheets(1).Name = NameSht Sheets(1).Cells.ClearContents Sheets(2).Cells(2, 1).Resize(, j1).Copy Sheets(1).Cells(1, 1) Application.ScreenUpdating = False k_n = Worksheets.Count - 1 ReDim i_n(k_n) ReDim shtName(k_n) '________________________создание массива кол-ва строк на каждом листе______начало For Each sht In ActiveWorkbook.Worksheets If sht.Index <> 1 Then i_n(sht.Index - 1) = sht.Cells(Rows.Count, 3).End(xlUp).Row shtName(sht.Index - 1) = sht.Name If i_nn < i_n(sht.Index - 1) Then i_nn = i_n(sht.Index - 1) End If End If Next sht
'________________________создание массива кол-ва строк на каждом листе______конец ReDim Tablica(Worksheets.Count - 1, i_nn, j1) For Each sht In ActiveWorkbook.Worksheets If sht.Index <> 1 Then i1 = 0 'скидываем на первую строку For i = Shapka + 1 To i_n(sht.Index - 1) i1 = i1 + 1 For j = 1 To j1 Tablica(sht.Index - 1, i1, j) = sht.Cells(i, j) Next j ' MsgBox (Tablica(sht.Index - 1, i1, j1)) Next i End If Next sht i2 = 1 t = 2 For k = 1 To k_n For i = 1 To i_n(k) - Shapka i2 = i2 + 1 For j = 1 To j1 Worksheets(1).Cells(i2, j) = Tablica(k, i, j) Next j Set cell = Worksheets(1).Cells(i2, j1 + 1) Worksheets(1).Hyperlinks.Add Anchor:=cell, Address:="", _ SubAddress:="'" & shtName(k) & "'" & "!A" & Shapka + i cell.Formula = shtName(k) Next i Set cell = Worksheets(k + 1).Cells(1, 7) Worksheets(1).Hyperlinks.Add Anchor:=cell, Address:="", _ SubAddress:="'" & Worksheets(1).Name & "'" & "!A" & t cell.Formula = Worksheets(1).Name t = i2 + 1 With Worksheets(k + 1).Cells(1, 7).Font .Name = "Times New Roman" .Size = 12 .Bold = True .Italic = True End With With Worksheets(k + 1).Cells(1, 7) .WrapText = True End With Next k Application.ScreenUpdating = True Cells.RowHeight = 15 Rows(1).RowHeight = 55 Time_ = Time_1 - Timer Time_delta = Format(Time_ / 24 / 60 / 60, "hh\ч mm\м ss\с") MsgBox ("Выполненно за " & Time_delta) End Sub
Roman777, если вы используете артикулы для дальнейшего поиска по базам, у которых как я понял встречается ноль вначале, то есть два варианта, менять формат ячейки либо применять строковый символ в конце. либо внутри артикула, но только для значений имеющих ноль вначале [vba]
Код
if left (sht.Cells(i, j), 1) = "0" then Tablica(sht.Index - 1, i1, j) = sht.Cells(i, j) & "x" ' к примеру else Tablica(sht.Index - 1, i1, j) = sht.Cells(i, j) end if
[/vba]
конечно дальнейшая обработка этого значения обратная
Roman777, если вы используете артикулы для дальнейшего поиска по базам, у которых как я понял встречается ноль вначале, то есть два варианта, менять формат ячейки либо применять строковый символ в конце. либо внутри артикула, но только для значений имеющих ноль вначале [vba]
Код
if left (sht.Cells(i, j), 1) = "0" then Tablica(sht.Index - 1, i1, j) = sht.Cells(i, j) & "x" ' к примеру else Tablica(sht.Index - 1, i1, j) = sht.Cells(i, j) end if
[/vba]
конечно дальнейшая обработка этого значения обратнаяSAGE
Roman777, в вашем примере тоже общий формат ячейки и ноль не пропадает, при этом Excel выдает ошибку (Типа число представлено как текст) проверьте разность адаптации Excel одного варианта строковой переменной
[vba]
Код
Sub число_как_текст()
Dim m As String
With ActiveSheet
m = "0123456"
.Cells(1, 2).Value = m ' будет числом
.Cells(2, 2).NumberFormat = "@" .Cells(2, 2).Value = m ' будет уже строкой текста
End With
End Sub
[/vba]
Roman777, в вашем примере тоже общий формат ячейки и ноль не пропадает, при этом Excel выдает ошибку (Типа число представлено как текст) проверьте разность адаптации Excel одного варианта строковой переменной
[vba]
Код
Sub число_как_текст()
Dim m As String
With ActiveSheet
m = "0123456"
.Cells(1, 2).Value = m ' будет числом
.Cells(2, 2).NumberFormat = "@" .Cells(2, 2).Value = m ' будет уже строкой текста
SAGE, Спасибо за информацию. Насчёт добавления символов... я уже думал над таким. Думал просто, что есть вариант по-проще. И ведь хотелось поменьше работать с ячейкой - побольше с массивом (видимо вариант с дополнительным символом тут лучше всего подходит), а то и так для моего конечного файла макросу приходится около 10 минут работать. Хотя, вероятнее всего, вина лежит на установлении определённого форматирования, прописанном в конце макроса))). nilem, Вряд ли, ведь когда я тыкал на эту ячейку, нолик исчезал и ячейка принимала значение "7332", а пока не тыкал, значение так и оставалось "07332".
SAGE, Спасибо за информацию. Насчёт добавления символов... я уже думал над таким. Думал просто, что есть вариант по-проще. И ведь хотелось поменьше работать с ячейкой - побольше с массивом (видимо вариант с дополнительным символом тут лучше всего подходит), а то и так для моего конечного файла макросу приходится около 10 минут работать. Хотя, вероятнее всего, вина лежит на установлении определённого форматирования, прописанном в конце макроса))). nilem, Вряд ли, ведь когда я тыкал на эту ячейку, нолик исчезал и ячейка принимала значение "7332", а пока не тыкал, значение так и оставалось "07332".Roman777
wild_pig, подскажите пожалуйста, что вы имели в виду, ато я даже по вашему примеру не очень понял, что значит "выгружать весь массив сразу", такое подойдет только при массиве размерностью в один элемент?
wild_pig, подскажите пожалуйста, что вы имели в виду, ато я даже по вашему примеру не очень понял, что значит "выгружать весь массив сразу", такое подойдет только при массиве размерностью в один элемент?Roman777
как раз тот случай, когда ...таблицы с общим форматом ячейки, там были числа аля "07332". "0" не пропадал. но когда я тыкал на эту ячейку, нолик исчезал и ячейка принимала значение "7332" даже если Dim Tablica() As String
Имхо, только 2 варианта: формат ячеек текстовый или ставить впереди апостроф, чтобы превратить число в текст
как раз тот случай, когда ...таблицы с общим форматом ячейки, там были числа аля "07332". "0" не пропадал. но когда я тыкал на эту ячейку, нолик исчезал и ячейка принимала значение "7332" даже если Dim Tablica() As String
Имхо, только 2 варианта: формат ячеек текстовый или ставить впереди апостроф, чтобы превратить число в текстnilem
If Left(Tablica(k, i, j), 1) = 0 Then Worksheets(1).Cells(i2, j).NumberFormat = "@" End If Worksheets(1).Cells(i2, j) = Tablica(k, i, j)
[/vba] Хочу уточнить, апостроф просто сделает число строкой? и в дальнейшем, если я захочу выполнить что-то типа ВПР (сравнение массивов), буду сравнивать "'07332" и "07332", мне естественно, этот апостроф надо будет удалять?
nilem, наверное Вы правы, добавлю условие: [vba]
Код
If Left(Tablica(k, i, j), 1) = 0 Then Worksheets(1).Cells(i2, j).NumberFormat = "@" End If Worksheets(1).Cells(i2, j) = Tablica(k, i, j)
[/vba] Хочу уточнить, апостроф просто сделает число строкой? и в дальнейшем, если я захочу выполнить что-то типа ВПР (сравнение массивов), буду сравнивать "'07332" и "07332", мне естественно, этот апостроф надо будет удалять?Roman777
Апостроф мешать не должен. Но можно ведь проверить. 0123 0123 TRUE одно "число" было с апострофом (общий формат ячейки), второе без (текстовый формат ячейки) - формула отличий не нашла.
Апостроф мешать не должен. Но можно ведь проверить. 0123 0123 TRUE одно "число" было с апострофом (общий формат ячейки), второе без (текстовый формат ячейки) - формула отличий не нашла.Hugo