Перенести данные штрих кода и цен на другой лист. - Страница 2

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

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

Мир MS Excel » Вопросы и решения » Вопросы по Excel » Перенести данные штрих кода и цен на другой лист. (Формулы/Formulas)

Перенести данные штрих кода и цен на другой лист.

Manyasha

Дата: Пятница, 07.10.2016, 22:31 | Сообщение № 21

Группа: Модераторы

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

Сообщений: 2198

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

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

Excel 2010, 2016

Mark1976, последняя строка на листе с данными считается по первому столбцу:
[vba]

Код

lr = .Cells(Rows.Count, 1).End(xlUp).Row

[/vba]
измените на реально заполненный столбец, например F
[vba]

Код

lr = .Cells(Rows.Count, "f").End(xlUp).Row

[/vba]

UPD
прокомментировала в коде места, от которых зависит сбор и вывод данных:

[vba]

Код

Sub svod()
    Dim sh1 As Worksheet, sh2 As Worksheet, barcode, price, lr&, i&, res
    Dim arrKeys, arrItems, temp, col#
    'Запоминаем лист с исходными данными
    Set sh1 = ThisWorkbook.Sheets("Данные")
    'запоминаем лист с результатом
    Set sh2 = ThisWorkbook.Sheets("Свод")
    With sh1
        'ищем последнюю строчку по столбцу F на листе с данными
        lr = .Cells(Rows.Count, "f").End(xlUp).Row
        'запоминаем цены в массив price
        price = .Range("f2:f" & lr).Value
        'запоминаем штрих-коды в массив barcode
        barcode = .Range("i2:i" & lr).Value
    End With
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(barcode)
            If .exists(Trim(barcode(i, 1))) Then
                .Item(Trim(barcode(i, 1))) = .Item(Trim(barcode(i, 1))) & "|" & price(i, 1)
            Else
                .Item(Trim(barcode(i, 1))) = price(i, 1)
            End If
        Next i
        arrKeys = .keys
        arrItems = .items
    End With
    With sh2
        'на листе с результатом удаляем старые данные, начиная со 2-й строки (Offset(1))
        '(в примере 1-я для шапки)
        .[a1].CurrentRegion.Offset(1).ClearContents
        'заполняем новыми данными, начиная со 2-й строки (i+2)
        For i = 0 To UBound(arrKeys)
            .Cells(i + 2, 1) = arrKeys(i)
            temp = Split(arrItems(i), "|")
            col = IIf(UBound(temp), UBound(temp) + 1, 1)
            .Cells(i + 2, 2).Resize(, col) = temp
        Next i
    End With
End Sub

[/vba]

Mark1976, последняя строка на листе с данными считается по первому столбцу:
[vba]

Код

lr = .Cells(Rows.Count, 1).End(xlUp).Row

[/vba]
измените на реально заполненный столбец, например F
[vba]

Код

lr = .Cells(Rows.Count, "f").End(xlUp).Row

[/vba]

UPD
прокомментировала в коде места, от которых зависит сбор и вывод данных:

[vba]

Код

[/vba]

Manyasha

ЯД: 410013299366744 WM: R193491431804

Сообщение отредактировал Manyasha - Пятница, 07.10.2016, 22:40

Ответить

СообщениеMark1976, последняя строка на листе с данными считается по первому столбцу:
[vba]

Код

lr = .Cells(Rows.Count, 1).End(xlUp).Row

[/vba]
измените на реально заполненный столбец, например F
[vba]

Код

lr = .Cells(Rows.Count, "f").End(xlUp).Row

[/vba]

UPD
прокомментировала в коде места, от которых зависит сбор и вывод данных:

[vba]

Код

[/vba]

Автор - Manyasha
Дата добавления - 07.10.2016 в 22:31

Mark1976

Дата: Пятница, 07.10.2016, 22:51 | Сообщение № 22

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

Ранг: Ветеран

Сообщений: 738

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

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

Excel 2010, 2013

Все работает (макрос). Очень помогли. Всем спасибо за участие.

Ответить

Mark1976

Дата: Пятница, 07.10.2016, 23:48 | Сообщение № 23

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

Ранг: Ветеран

Сообщений: 738

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

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

Excel 2010, 2013

Цитата

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

При формировании темы была просьба убрать дубликаты. Можно это сделать в данном макросе.
[vba]

Код

[/vba]
Например если строка имеет такие данные: 123,50 123,50 124,20
Оставить: 123,50 124,20

Цитата

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

При формировании темы была просьба убрать дубликаты. Можно это сделать в данном макросе.
[vba]

Код

[/vba]
Например если строка имеет такие данные: 123,50 123,50 124,20
Оставить: 123,50 124,20Mark1976

Ответить

Сообщение

Цитата

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

При формировании темы была просьба убрать дубликаты. Можно это сделать в данном макросе.
[vba]

Код

[/vba]
Например если строка имеет такие данные: 123,50 123,50 124,20
Оставить: 123,50 124,20

Автор - Mark1976
Дата добавления - 07.10.2016 в 23:48

Manyasha

Дата: Суббота, 08.10.2016, 01:07 | Сообщение № 24

Группа: Модераторы

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

Сообщений: 2198

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

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

Excel 2010, 2016

Mark1976, посмотрите такой вариант:
[vba]

Код

Sub svod()
    Dim sh1 As Worksheet, sh2 As Worksheet, barcode, price, lr&, i&, j&, res
    Dim arrKeys, arrItems, temp, col#
    'Запоминаем лист с исходными данными
    Set sh1 = ThisWorkbook.Sheets("Данные")
    'запоминаем лист с результатом
    Set sh2 = ThisWorkbook.Sheets("Свод")
    With sh1
        'ищем последнюю строчку по столбцу F на листе с данными
        lr = .Cells(Rows.Count, "f").End(xlUp).Row
        'запоминаем цены в массив price
        price = .Range("f2:f" & lr).Value
        'запоминаем штрих-коды в массив barcode
        barcode = .Range("i2:i" & lr).Value
    End With
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(barcode)
            If .exists(Trim(barcode(i, 1))) Then
                .Item(Trim(barcode(i, 1))) = .Item(Trim(barcode(i, 1))) & "|" & price(i, 1)
            Else
                .Item(Trim(barcode(i, 1))) = price(i, 1)
            End If
        Next i
        arrKeys = .keys
        arrItems = .items
    End With
    With sh2
        'на листе с результатом удаляем старые данные, начиная со 2-й строки (Offset(1))
        '(в примере 1-я для шапки)
        .[a1].CurrentRegion.Offset(1).ClearContents
        'заполняем новыми данными, начиная со 2-й строки (i+2)
        For i = 0 To UBound(arrKeys)
            .Cells(i + 2, 1) = arrKeys(i)
            temp = Split(arrItems(i), "|")
            If UBound(temp) = 0 Then
                .Cells(i + 2, 2) = arrItems(i)
            Else
                With CreateObject("scripting.dictionary")
                    For j = 0 To UBound(temp)
                        .Item(temp(j)) = j
                    Next j
                    sh2.Cells(i + 2, 2).Resize(, .Count) = .keys
                End With
            End If
        Next i
    End With
End Sub

[/vba]

Mark1976, посмотрите такой вариант:
[vba]

Код