Имеется товар, который продается только парами, но на некоторых магазинах он находится по 1 шт. Я вывел огромную таблицу более чем на 10000 позиций по 1 шт. на разных магазинах. Хотелось бы формулой соединить эти пары вместе для наилучшей продажи. Уже всю голову сломал, пробовал заходить с разных углов, никак не получается.
Пример таблицы во вложении и что должно получиться. Главная цель: создать ниже удобную таблицу для сортировки и создания перемещений.
Решение нужно исключительно формулами? И по какому принципу нужно определять отправителя и получателя? Например, почему именно из Москвы в Находку, а не наоборот? Что делать, если в трёх городах по одной штуке? Как формировать пару?
Юрий М написал: Решение нужно исключительно формулами?И по какому принципу нужно определять отправителя и получателя? Например, почему именно из Москвы в Находку, а не наоборот?Что делать, если в трёх городах по одной штуке? Как формировать пару?
Можно макросом, но мне кажется он сильно подгрузит систему, таблица очень большая. Отправитель и получатель определяется по наличию 1 шт. Грубо говоря нужно соединить две точки у которых есть 1 шт. Не важно если будет отправитель - получатель либо получатель-отправитель. Главное соединить пары. Если 3 шт. то соединить первые две точки, третью подписать «Без пары»
Sub ВаленкиВаленки()
Const sRANGE = "A1:J35"
Const BUFF_SIZE = 1000
Dim arr As Variant
arr = ActiveSheet.Range(sRANGE)
Dim aOu As Variant
ReDim aOu(1 To BUFF_SIZE, 1 To 6)
Dim sh As Worksheet
Set sh = Workbooks.Add(1).Sheets(1)
sh.Cells(1, 1).Resize(1, 6) = Array("Отправитель", "Получатель", "Код товара", "Наимен.", "Кол-во", "Комментарий")
Dim f As Boolean
Dim y As Long
Dim u As Integer
Dim x As Integer
For x = 2 To UBound(arr, 2)
f = True
For y = 3 To UBound(arr, 1)
If arr(y, x) = 1 Then
If f Then
u = u + 1
If u > UBound(aOu, 1) Then
OutArray aOu, sh
u = 1
ReDim aOu(1 To BUFF_SIZE, 1 To 6)
End If
aOu(u, 1) = arr(y, 1)
aOu(u, 3) = arr(1, x)
aOu(u, 4) = arr(2, x)
aOu(u, 5) = 1
Else
aOu(u, 2) = arr(y, 1)
aOu(u, 6) = aOu(u, 1) & " - " & aOu(u, 2) & ". Перемещение на пополнение."
End If
f = Not f
End If
If Not f Then
aOu(u, 2) = "Нет пары"
aOu(u, 6) = "Нет пары"
End If
Next
Next
OutArray aOu, sh
sh.Parent.Saved = True
End Sub
Sub OutArray(aOu As Variant, sh As Worksheet)
With sh
.Cells(.Rows.Count, 1).End(xlUp).Cells(2, 1).Resize(UBound(aOu, 1), UBound(aOu, 2)) = aOu
End With
End Sub
А ещё нужно расстояние между пунктами отправки, чтобы правильно составить логистику и не везти во Владивосток из Астрахани если можно привезти из Находки
Черт побери, да вы мать его, гении. Я не успел с работы приехать, а вы уже макросы сделали. Всё работает, идеально.Ребята скиньте в личку какие-нибудь данные, я хоть отправлю вам на пиво )