Связать листы по продажам

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

Связать листы по продажам (Макросы/Sub)

daolg

Дата: Воскресенье, 20.09.2015, 12:43 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

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

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

Excel 2013

Здравствуйте. Помогите решить такой вопрос.
Есть лист "Товары" и лист "Продажи".
Необходимо, чтобы при вводе на листе "Продажи" товара(ячейки A2:A50), имеющегося на листе "Товары"(A2:A4) и ввода размера в листе "Продажи"(B2:B50), которые есть в соответственном товаре на листе "Товары"(B2:B4), размер у соответствующего товара на листе "Товары" вычитался, при условии что такой размер есть. Необходимо предусмотреть вариант, при котором на листе "Товары" несколько одинаковых размеров(41 42 42 42 43), а списывается только один(42), то остаёться 41 42 42 43, а не 41 43. В идеале, конечно, при удалении продажи с листа "Продажи" чтобы размер возвращался соответствующему товару на листе "Товары".
Такая вот задачка и надеюсь Вы поймёте что я тут написал

К сообщению приложен файл: 1264714.xlsx (9.9 Kb)

Сообщение отредактировал daolg - Воскресенье, 20.09.2015, 12:46

Ответить

Revengencer

Дата: Воскресенье, 20.09.2015, 15:50 | Сообщение № 2

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

Ранг: Новичок

Сообщений: 34

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

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

Excel 2016

Вот такой вариант (добавил именованные диапазоны и форматирование как таблицу).
Если в таблицу "продажи" ввести размер обуви, которого уже не должно быть на складе, то появляется соотвествующее сообщение.

'при удалении продажи с листа "Продажи" чтобы размер возвращался соответствующему товару на листе "Товары"' - поддерживается (но только если удалить всю строку: т.е. не только очистить ячейку с размером, но и ячейку с типом обуви).

Столбец B2 на первом листе можно скрыть (но не удалять).

[vba]

Код

Sub LeftSizes()
       Dim Sales() As Variant
       Dim Sizes() As Variant
       Dim TextS As String
       Dim j As Integer, i As Integer, Pos As Integer

       Sales = Range("Sales").Value
       Sizes = Range("Sizes").Value

       For i = 1 To Range("Sizes").Rows.Count
           TextS = Sizes(i, 2)
           For j = 1 To Range("Sales").Rows.Count
               If Sales(j, 1) = Sizes(i, 1) Then
                   Pos = InStr(TextS, Sales(j, 2))
                   If Pos = 0 Then
                       MsgBox "В товарах категории " & "'" & Sales(j, 1) & "'" & " нет размера " & "'" & Sales(j, 2) & "'", vbExclamation, "Нет размера"
                   End If
                   If Pos = Len(TextS) - 1 Then
                       TextS = Left(TextS, Pos - 1)
                       Else
                       TextS = Left(TextS, Pos - 1) & Right(TextS, Len(TextS) - Pos - 2)
                   End If
               End If
           Next j
           Sheets("товары").Cells(i + 1, 3).Value = TextS
       Next i
End Sub

[/vba]

Код

[/vba]Revengencer

К сообщению приложен файл: 1983274.xlsm (20.6 Kb)

Сообщение отредактировал Revengencer - Воскресенье, 20.09.2015, 15:56

Ответить

СообщениеВот такой вариант (добавил именованные диапазоны и форматирование как таблицу).
Если в таблицу "продажи" ввести размер обуви, которого уже не должно быть на складе, то появляется соотвествующее сообщение.

'при удалении продажи с листа "Продажи" чтобы размер возвращался соответствующему товару на листе "Товары"' - поддерживается (но только если удалить всю строку: т.е. не только очистить ячейку с размером, но и ячейку с типом обуви).

Столбец B2 на первом листе можно скрыть (но не удалять).

[vba]

Код

[/vba]

Автор - Revengencer
Дата добавления - 20.09.2015 в 15:50

Revengencer

Дата: Воскресенье, 20.09.2015, 16:14 | Сообщение № 3

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

Ранг: Новичок

Сообщений: 34

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

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

Excel 2016

А еще лучше добавить строчку Exit Sub после MsgBox, чтобы программа автоматические закрывалась после ошибки.

[vba]

Код

If Pos = 0 Then
MsgBox "В товарах категории " & "'" & Sales(j, 1) & "'" & " нет размера " & "'" & Sales(j, 2) & "'", vbExclamation, "Нет размера"
Exit Sub
End If

[/vba]

Сообщение отредактировал Revengencer - Воскресенье, 20.09.2015, 16:14

Ответить

daolg

Дата: Воскресенье, 20.09.2015, 16:30 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

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

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

Excel 2013

Revengencer, Замечательно, практически то , что нужно.
Проблема в том, что при добавлении новой позиции с размерами на лист "Товары" и фиксацию продажи по этой позиции на листе "Продажи" , списывания не происходит, т.к. нужно добавлять в диапазон эту новую позицию и её входящие размеры.
Ранее изучал VBA и помню был currentregion(данное свойство возвращает прямоугольную область заполненных ячеек, смежных с той, из которой свойство вызвано) или что-то похожее. С использованием этого свойства можно не добавлять ячейки в диапазон. Он их сам добавляет. Как это реализовать на этом примере?

Ответить

Revengencer

Дата: Воскресенье, 20.09.2015, 17:22 | Сообщение № 5

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

Ранг: Новичок

Сообщений: 34

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

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

Excel 2016

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

К сообщению приложен файл: 8012419.xlsm (22.1 Kb)

Сообщение отредактировал Revengencer - Воскресенье, 20.09.2015, 17:51

Ответить

daolg

Дата: Воскресенье, 20.09.2015, 18:28 | Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

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

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

Excel 2013

Revengencer, большое спасибо. Всё работает

Ответить

space25

Дата: Понедельник, 05.10.2015, 20:34 | Сообщение № 7

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

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

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

Excel 2010

Доброго времени суток!!! У меня есть похожая проблема, нужна из одного листа, с общим списком перенести данные по продажам на отдельный лист по каждой точке. Путем долгих размышлений, придуман был такой макрос:
[vba]

Код

Sub îîñ6()
'
' îîñ6 Macro
'

'
Range("A10:B10").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
Range("B4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[6]C[2]"
Range("B5").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[5]C[5]"
Range("B6").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[4]C[8]"
Range("B7").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[3]C[11]"
Range("B8").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[2]C[14]"
Range("B9").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[1]C[17]"
Range("B10").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!RC[20]"
Range("B11").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-1]C[23]"
Range("B12").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-2]C[23]"
Range("B12").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-2]C[26]"
Range("B13").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-3]C[29]"
Range("B14").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-4]C[32]"
Range("B15").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-5]C[35]"
Range("B16").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-6]C[38]"
Range("B17").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-7]C[41]"
Range("B18").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-8]C[44]"
Range("B19").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-9]C[47]"
Range("B20").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-10]C[50]"
Range("B21").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-11]C[53]"
Range("B22").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-12]C[56]"
Range("B23").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-13]C[59]"
Range("B24").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-14]C[62]"
Range("B25").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-15]C[65]"
Range("B26").Select
ActiveCell.FormulaR1C1 = "=ÎÒÇ!R[-16]C[68]"
Range("B27").Select
ActiveWindow.SmallScroll Down:=-18
Range("B4").Select
Selection.AutoFill Destination:=Range("B4:C4"), Type:=xlFillDefault
Range("B4:C4").Select
Selection.AutoFill Destination:=Range("B4:D4"), Type:=xlFillDefault
Range("B4:D4").Select
Range("B5").Select
Selection.AutoFill Destination:=Range("B5:D5"), Type:=xlFillDefault
Range("B5:D5").Select
Range("B6").Select
Selection.AutoFill Destination:=Range("B6:D6"), Type:=xlFillDefault
Range("B6:D6").Select
Range("B7").Select
Selection.AutoFill Destination:=Range("B7:D7"), Type:=xlFillDefault
Range("B7:D7").Select
Range("B8").Select
Selection.AutoFill Destination:=Range("B8:D8"), Type:=xlFillDefault
Range("B8:D8").Select
Range("B9").Select
Selection.AutoFill Destination:=Range("B9:D9"), Type:=xlFillDefault
Range("B9:D9").Select
Range("B10").Select
Selection.AutoFill Destination:=Range("B10:D10"), Type:=xlFillDefault
Range("B10:D10").Select
Range("B11").Select
Selection.AutoFill Destination:=Range("B11:D11"), Type:=xlFillDefault
Range("B11:D11").Select
Range("B12").Select
Selection.AutoFill Destination:=Range("B12:D12"), Type:=xlFillDefault
Range("B12:D12").Select
Range("B13").Select
Selection.AutoFill Destination:=Range("B13:D13"), Type:=xlFillDefault
Range("B13:D13").Select
Range("B14").Select
Selection.AutoFill Destination:=Range("B14:D14"), Type:=xlFillDefault
Range("B14:D14").Select
Range("B15").Select
Selection.AutoFill Destination:=Range("B15:D15"), Type:=xlFillDefault
Range("B15:D15").Select
Range("B16").Select
Selection.AutoFill Destination:=Range("B16:D16"), Type:=xlFillDefault
Range("B16:D16").Select
Range("B17").Select
Selection.AutoFill Destination:=Range("B17:D17"), Type:=xlFillDefault
Range("B17:D17").Select
Range("B18").Select
Selection.AutoFill Destination:=Range("B18:D18"), Type:=xlFillDefault
Range("B18:D18").Select
Range("B19").Select
Selection.AutoFill Destination:=Range("B19:D19"), Type:=xlFillDefault
Range("B19:D19").Select
ActiveWindow.SmallScroll Down:=3
Range("B20").Select
Selection.AutoFill Destination:=Range("B20:D20"), Type:=xlFillDefault
Range("B20:D20").Select
Range("B21").Select
Selection.AutoFill Destination:=Range("B21:D21"), Type:=xlFillDefault
Range("B21:D21").Select
Range("B22").Select
Selection.AutoFill Destination:=Range("B22:D22"), Type:=xlFillDefault
Range("B22:D22").Select
ActiveWindow.SmallScroll Down:=6
Range("B23").Select
Selection.AutoFill Destination:=Range("B23:D23"), Type:=xlFillDefault
Range("B23:D23").Select
Range("B24").Select
Selection.AutoFill Destination:=Range("B24:D24"), Type:=xlFillDefault
Range("B24:D24").Select
Range("B25").Select
Selection.AutoFill Destination:=Range("B25:D25"), Type:=xlFillDefault
Range("B25:D25").Select
Range("B26").Select
Selection.AutoFill Destination:=Range("B26:D26"), Type:=xlFillDefault
Range("B26:D26").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.SmallScroll Down:=-15
Sheets("ÎÒÇ").Select
MsgBox ("Данные успешно скопированы")

[/vba]

Помогите разобраться, как скопировать этот макрос и где поменять (в каких строках) ячейки, чтобы этот макрос работал также и на строки и ячейки ниже.
Пример файла во вложении. Т.е из листа ОТЗ из строки под номером 4 нужно перенести данные в лист Sheets2 только в горизонтальном варианте и в дальнейшем со сдвигом на строку вниз для каждой из последующих строк.
Сорри за такое описание, но проще написать не знаю как))
[moder]Читаем Правила форума, создаём свою тему, эта тема закрыта. Код следует оформлять тегами (кнопка #)[/moder]

Код

Сообщение отредактировал Pelena - Понедельник, 05.10.2015, 21:40

Ответить

СообщениеДоброго времени суток!!! У меня есть похожая проблема, нужна из одного листа, с общим списком перенести данные по продажам на отдельный лист по каждой точке. Путем долгих размышлений, придуман был такой макрос:
[vba]

Код

Автор - space25
Дата добавления - 05.10.2015 в 20:34

Связать листы по продажам (Макросы/Sub)

Страница 1 из 1
1