Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

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

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 2 из 2«12
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Перенести данные штрих кода и цен на другой лист. (Формулы/Formulas)
Перенести данные штрих кода и цен на другой лист.
Manyasha Дата: Пятница, 07.10.2016, 22:31 | Сообщение № 21
Группа: Модераторы
Ранг: Старожил
Сообщений: 1589
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
Mark1976, последняя строка на листе с данными считается по первому столбцу:
[vba]
Код
lr = .Cells(Rows.Count, 1).End(xlUp).Row
[/vba]
измените на реально заполненный столбец, например F
[vba]
Код
lr = .Cells(Rows.Count, "f").End(xlUp).Row
[/vba]

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


marinamorozova_box@mail.ru
ЯД: 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
прокомментировала в коде места, от которых зависит сбор и вывод данных:

Автор - Manyasha
Дата добавления - 07.10.2016 в 22:31
Mark1976 Дата: Пятница, 07.10.2016, 22:51 | Сообщение № 22
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

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

Автор - Mark1976
Дата добавления - 07.10.2016 в 22:51
Mark1976 Дата: Пятница, 07.10.2016, 23:48 | Сообщение № 23
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
Цитата
А потом если строке встречаются дубли, то одну цифру удалить.
При формировании темы была просьба убрать дубликаты. Можно это сделать в данном макросе.
[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]
Например если строка имеет такие данные: 123,50 123,50 124,20
Оставить: 123,50 124,20
 
Ответить
Сообщение
Цитата
А потом если строке встречаются дубли, то одну цифру удалить.
При формировании темы была просьба убрать дубликаты. Можно это сделать в данном макросе.
[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]
Например если строка имеет такие данные: 123,50 123,50 124,20
Оставить: 123,50 124,20

Автор - Mark1976
Дата добавления - 07.10.2016 в 23:48
Manyasha Дата: Суббота, 08.10.2016, 01:07 | Сообщение № 24
Группа: Модераторы
Ранг: Старожил
Сообщений: 1589
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
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]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение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]

Автор - Manyasha
Дата добавления - 08.10.2016 в 01:07
Mark1976 Дата: Суббота, 08.10.2016, 07:32 | Сообщение № 25
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
Manyasha, все работает. Спасибо.
 
Ответить
СообщениеManyasha, все работает. Спасибо.

Автор - Mark1976
Дата добавления - 08.10.2016 в 07:32
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Перенести данные штрих кода и цен на другой лист. (Формулы/Formulas)
Страница 2 из 2«12
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!