Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 След.
Запись CSV в массив. Какой разделитель строк?
 
sokol92, все работает. Спасибо большое!
Запись CSV в массив. Какой разделитель строк?
 
sokol92, добрый день. vbNewLine уже пробовал. Не переносит строки с таким разделителем. То есть, я вижу, что в массив кидается с разделителем " ", но не перемещает на новую строку
Изменено: Hellmaster - 31 Янв 2020 11:54:26
Запись CSV в массив. Какой разделитель строк?
 
Добрый день. Нашел в интернете решение по переносу csv в массив, но не пойму, какой разделитель строк в этом файле. В массив все заносится в 1 столбец. Код ниже, файл во вложении. Какой должен быть разделитель строк в этом csv файле?
Код
Sub mass()
fldr = "C:\"
s = "testdata-1000.csv"

b = TextFile2Array(, fldr, , s)
End sub
____________________________
Function TextFile2Array(Optional ByVal Title As String = "Выберите файл для обработки", _
                        Optional ByVal InitialPath As String = "c:\", _
                        Optional ByVal FilterDescription As String = "Текстовые файлы", _
                        Optional ByVal FilterExtention As String = "*.*", _
                        Optional ByVal ColumnsSeparator$ = ";", _
                        Optional ByVal RowsSeparator$ = "?") As Variant 'какой должен быть разделитель строк?

    On Error Resume Next

    With Application.FileDialog(msoFileDialogOpen)    ' диалоговое окно выбора файла CSV
        .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
        .Filters.Clear: .Filters.Add FilterDescription, FilterExtention
        If .Show <> -1 Then Exit Function
        filename$ = .SelectedItems(1)
    End With
    Set FSO = CreateObject("scripting.filesystemobject")    ' читаем текст из выбранного файла
    Set ts = FSO.OpenTextFile(filename$, 1, True): txt$ = ts.ReadAll: ts.Close
    Set ts = Nothing: Set FSO = Nothing
    txt = Trim(txt): Err.Clear    ' разделяем текст на строки и столбцы
    If txt Like "*" & RowsSeparator$ Then txt = Left(txt, Len(txt) - Len(RowsSeparator$))
    tmpArr1 = Split(txt, RowsSeparator$): RowsCount = UBound(tmpArr1) + 1
    ColumnsCount = UBound(Split(tmpArr1(0), ColumnsSeparator$)) + 1
    If Err.Number > 0 Then MsgBox "Строка не может быть разбита на двумерный массив", vbCritical: End
    ReDim arr(1 To RowsCount, 1 To ColumnsCount)
    For i = LBound(tmpArr1) To UBound(tmpArr1)
        tmpArr2 = Split(Trim(tmpArr1(i)), ColumnsSeparator$)
        For j = 1 To UBound(tmpArr2) + 1
            arr(i + 1, j) = tmpArr2(j - 1)
        Next j
    Next i
    TextFile2Array = arr    ' возвращаем результат в виде двумерного массива
End Function
Изменено: Hellmaster - 31 Янв 2020 11:54:35
Замена(ускорение) с помощью VBA формулы ВПР
 
Дмитрий(The_Prist) Щербаков, я поэтому и переспросил) Спасибо за помощь. Буду дальше совершенствовать свой навык!
Замена(ускорение) с помощью VBA формулы ВПР
 
Значит вся проблема была в отображении у меня Item? у меня просто не отображается больше 256 элементов?
Замена(ускорение) с помощью VBA формулы ВПР
 
Дмитрий(The_Prist) Щербаков, вот мой код полностью.
Код
Sub NewVPR()

    Dim a()
    Dim i&
    Dim sd As Object
    Dim sh1 As Worksheet: Set sh1 = Workbooks("Пример.xlsb").Sheets(1)
    Dim sh2 As Worksheet: Set sh2 = ActiveSheet

    a = sh1.UsedRange.Value
    Set sd = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
      Key = a(i, 1) ' получаем ключ из первого столбца текущей строки массива
      Item = a(i, 7) ' получаем элемент из седьмого столбца текущей строки массива
      sd.Add Key, Item ' и добавляем новый элемент в коллекцию
    Next
    a = sh2.UsedRange.Value
    For i = 1 To UBound(a)
        If sd.Exists(a(i, 1)) Then a(i, 8) = sd.Item(a(i, 1))

    Next
    sh2.Cells(1, 1).Resize(UBound(a), UBound(a, 2)) = a
End Sub
Замена(ускорение) с помощью VBA формулы ВПР
 
МатросНаЗебре, в том то и дело, что count правильный, а item только 256. Соответственно, в итоговую таблицу подтягивает только 256 значений из словаря, а не 7000, как делает впр.
Замена(ускорение) с помощью VBA формулы ВПР
 
Пример во вложении. Так же прилагаю пару скриншотов. Столбец1 - столбец с ключом.
Замена(ускорение) с помощью VBA формулы ВПР
 
Jack Famous, да, уже проштудировал этот и многие другие сайты. Но у меня в словарь добавляется максимум 256 item.
Соответственно, когда тяну из словаря данные, тянется только 256 значений.
Ошибку не вызывает, дублей нет. У меня просто в словарь добавляется 256 item вместо нужных 7000. Объясните, пожалуйста, что я не так делаю
Изменено: Hellmaster - 22 Янв 2020 13:58:02
Замена(ускорение) с помощью VBA формулы ВПР
 
МатросНаЗебре, у меня в словарь добавляется 256 строк, при этом циклом проходит все строки массива а (7000 строк). Как расширить словарь, чтобы в него поместились все ключи (7000 строк)?
Код
a = sh1.UsedRange.Value
    Set sd = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
      Key = a(i, 1)
      Item = a(i, 7) 
      sd.Add Key, Item 
    Next
Изменено: Hellmaster - 22 Янв 2020 13:52:55
Замена(ускорение) с помощью VBA формулы ВПР
 
БМВ,спасибо. Использовал формулу индекс(поискпоз. сработало быстрее, но не намного.
МатросНаЗебре, спасибо. Проверю- отпишусь в эту тему.
Jack Famous, спасибо. Насколько я понял, вы предлагаете создать отдельный столбец с =поискпоз(), а дальше работать со словарем? Сортировки в обоих массивах сделаны до использования формул для меньшего кол-ва вхождений.  
Замена(ускорение) с помощью VBA формулы ВПР
 
Добрый день. Есть 2 файла с 300 000+ строк и 30+ столбцов. Из одного файла в другой надо заВПРить более 15 столбцов по 1 столбцу с ключом. Есть макрос, в котором прописаны именно ВПР типа
Код
Set x = Workbooks(xFile).Worksheets(xsheet).Rows(1).find("Поставщик", , xlFormulas, xlWhole)
   x1 = x.Column
 Cells(2, x1).FormulaR1C1 = "=VLOOKUP(C1,'[" & "Расчет_общий.xlsb" & "]" & xsheets & "'!C1:C8,8,0)" 
...
Application.Calculation = xlCalculationManual
Range("H2:S2").AutoFill Destination:=Range("H2:S" & xlastrow)
Application.Calculation = xlCalculationAutomatic
Range("H2:S" & xlastrow).Value = Range("H2:S" & xlastrow).Value

Таким способом макрос работает около часа. При отключении автоматического пересчета формул и включением после протягивания формул, макрос работает около 40 минут. Пробовал делать это циклом типа

Код
For i=1 to lastrow  
For i1=1 to lastrow2   
If cells(i,1)=cells(i1,1) then   
cells(i,10)=cells(i1,18) and _   
cells(i,12)=cells(i1,22) and _   
....   
End if  
Next i1
Next i

Работает такой вариант намного дольше (примерно 90 минут). Пробовал через массивы, в которые я закидывал обе таблицы + цикл типа предыдущего. Работает такой вариант тоже дольше чем ВПР.

Подскажите, пожалуйста, вариант, который будет работать быстрее. Если возможно, то небольшой пример кода с пояснениями.

Вставка в excel из массива построчно
 
Добрый день.

Имеется двухмерный массив. По условию я нахожу строку в массиве и нужно добавить ее в Excel. Пока что я смог только добавлять каждую ячейку. Подскажите как вставить сразу полностью строку в Excel.
Код
For i = 0 to 1000
  If b(56,i)="DRINK" then
    Workbooks("test").worksheets("test").range(cells(lr,1),cells(lr,lc))= range(b(0,i),b(135,i)) 'что-то вроде этого мне нужно
  End if
Next
APPCRASH экселя при сочетании клавиш с ctrl и открытии списка макросов во вкладке Разработчик.
 
Добрый день. Эксель начал крашиться при сочетании клавиш с ctrl. При этом мышкой все эти действия произвести можно. Та же проблема вылетает при работе с макросами, т.е. запись макроса, открытие Visual Basic, при нажатии на кнопку Макросы. Все что могу приложить-это скриншот ошибки. В чем может быть проблема?
Вычленить из ячейки с текстом номер договора через VBA
 
Вот то, что вам нужно  https://www.planetaexcel.ru/techniques/7/4844/
Отображение нулей в конце в текстовом формате
 
=текст(A1;"0,000")
Наименьшее по уникальным значениям
 
10.11.19 это восьмое минимальное значение)
Как перенести данный с листа на лист автоматичести?
 
изменил макрос из #3. Подсчитывает количество и не берет 0:30:00
Как перенести данный с листа на лист автоматичести?
 
Код
Sub vremya()
Dim lr As Long
Dim lr3 As Long

lr = Sheets("2").Cells(Rows.Count, 1).End(xlUp).Row
lr3 = 2
For i = 3 To lr
  If Sheets("2").Cells(i, 5).Value > 0.0209 Then
    Sheets("3").Cells(lr3, 5) = Sheets("2").Cells(i, 1)
    Sheets("3").Cells(lr3, 6) = Sheets("2").Cells(i, 2)
    Sheets("3").Cells(lr3, 7) = Sheets("2").Cells(i, 3)
    Sheets("3").Cells(lr3, 9) = Sheets("2").Cells(i, 5)
    lr3 = lr3 + 1
  End If
Next
Sheets("3").Cells(2, 8) = lr3 - 2 
  
End Sub
Изменено: Hellmaster - 30 Окт 2019 09:53:19
Как скрыть/показать именованный диапазон строк в VBA
 
БМВ, спасибо. Изучу этот момент
Как скрыть/показать именованный диапазон строк в VBA
 
Цитата
gribnick75 написал:
Range("range_subfloor_house").entryRows.Hidden = True
Код
entireRow.hidden
Как скрыть/показать именованный диапазон строк в VBA
 
БМВ,таки я не понял тогда. Я ошибся в задании Range, тем что начал с листа, а не с книги или я ошибся в скрытии строк?
Как скрыть/показать именованный диапазон строк в VBA
 
Тогда прошу прощения за незнание. Можно ссылочку, если не сложно, чтобы я изучил этот момент?
Как скрыть/показать именованный диапазон строк в VBA
 
Цитата
БМВ написал:
range("Mrows").EntireRow.Hidden=true
Цитата
Hellmaster написал:
myrows.Hidden = True
а в чем тогда разница?
Как скрыть/показать именованный диапазон строк в VBA
 
Либо вот так
Код
Dim myrows As Range
Set myrows = Sheets("лист1").Range(Rows(15), Rows(21))
а потом уже скрывать или раскрывать
Код
myrows.Hidden = True  'скрыть строки
myrows.Hidden = False  'показать строки
Как скрыть/показать именованный диапазон строк в VBA
 
gribnick75,
Код
sheets("лист1").Rows("15:21").Hidden = True  'скрыть строки
sheets("лист1").Rows("15:21").Hidden = False  'показать строки
Собрать через точку только непустые ячейки по строке
 
Я даже кнопочку добавлю
Собрать через точку только непустые ячейки по строке
 
lomaxx, так вам нужно и значение ячейки изменить и в результат вывести или только в результат вывести?
Собрать через точку только непустые ячейки по строке
 
Код
Sub pust()
Dim lc As Long
Dim rng1 As String
Dim rng2 As String
Dim rng3 As String
Dim rng4 As String

lc = Worksheets("Лист1").Cells(4, Columns.Count).End(xlToLeft).Column
rng1 = Cells(14, lc).Value
For a = 2 To lc - 1

  If Cells(14, a) <> "" Then
    rng1 = rng1 & "." & Cells(13, a)
  Else: GoTo Line1
  End If
Line1:
Next
Cells(14, lc).Value = rng1
If Left(Cells(14, lc), 1) = "." Then Cells(14, lc) = Right(Cells(14, lc), Len(Cells(14, lc)) - 1)

rng2 = Cells(15, lc).Value
For a = 2 To lc - 1

  If Cells(15, a) <> "" Then
    rng2 = rng2 & "." & Cells(13, a)
  Else: GoTo Line2
  End If
Line2:
Next
Cells(15, lc).Value = rng2
If Left(Cells(15, lc), 1) = "." Then Cells(15, lc) = Right(Cells(15, lc), Len(Cells(15, lc)) - 1)

rng3 = Cells(19, lc).Value
For a = 2 To lc - 1

  If Cells(19, a) <> "" Then
    rng3 = rng3 & "." & Cells(18, a)
  Else: rng3 = rng3 & ".00"
  End If
Next
Cells(19, lc).Value = rng3
If Left(Cells(19, lc), 1) = "." Then Cells(19, lc) = Right(Cells(19, lc), Len(Cells(19, lc)) - 1)

rng4 = Cells(20, lc).Value
For a = 2 To lc - 1

  If Cells(20, a) <> "" Then
    rng4 = rng4 & "." & Cells(18, a)
  Else: rng4 = rng4 & ".00"
  End If
Next
Cells(20, lc).Value = rng4
If Left(Cells(20, lc), 1) = "." Then Cells(20, lc) = Right(Cells(20, lc), Len(Cells(20, lc)) - 1)

End Sub
можно ли использовать метод Find для поиска по нескольким параметрам?, нужно найти информацию в таблице по двум ключевым столбцам - можно ли для этого использовать метод Find?
 
VIZ_VIZ, задайте переменную последней заполненной строки таблицы и сделайте
Код
With Worksheets(1).Range("a1:a" & lastrow)
Страницы: 1 2 3 4 5 6 7 След.
Наверх