Всем доброе время суток! Возможно как нибудь реализовать через формулу автоматического присвоения номера в конце товара? Примерно так
Груша 001 Груша 002 Груша 003 Яблоко 001 Яблоко 002 Яблоко 003 Груша 004 Груша 005 Яблоко 004 Задача вписать в таблице просто название товара а номер будет дописываться сам по порядку
Ну, сделайте, как сказал Максим В., скопируйте результат как значение в тот же столбец, а потом доп. столбец просто удалите. По-другому - только с помощью VBA.
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
Михаил Лебедев написал: По-другому - только с помощью VBA.
Скрытый текст
Код
Sub apple()
Dim lLastRow As Long, i As Long
Dim r As Range, n As Integer
Dim s As String, sO As String
Dim iRow As Integer, varTmp
Set r = Range("A1").CurrentRegion
lLastRow = r.Rows.Count
Static objDic As Dictionary
If objDic Is Nothing Then
Set objDic = New Dictionary
With r
For iRow = 1 To .Rows.Count
varTmp = objDic.Item(.Cells(iRow, 1).Value)
Next iRow
End With
End If
For iRow = 0 To objDic.Count - 1
n = 0
For i = 1 To lLastRow
If Cells(i, 1) = objDic.Keys(iRow) Then
s = Cells(i, 1)
n = n + 1
Select Case n
Case 1 To 9: sO = "_00"
Case 10 To 99: sO = "_0"
Case Is > 99: sO = "_"
End Select
Cells(i, 1) = s & sO & n
End If
Next i
Next iRow
End Sub
brat155 написал: при вводе дополнительного товара надо удалять старые значения так как макрос не пересчитывает
Добавьте товар и попробуйте:
Скрытый текст
Код
Sub apple()
Dim lLastRow As Long, i As Long
Dim r As Range, n As Integer
Dim s As String, sO As String
Dim iRow As Integer, varTmp
Set r = Range("A1").CurrentRegion
lLastRow = r.Rows.Count
Dim objDic As Dictionary
Set objDic = New Dictionary
With r
For iRow = 1 To .Rows.Count
If InStr(StrReverse(.Cells(iRow, 1)), "_") = 4 Then
.Cells(iRow, 1) = Left(.Cells(iRow, 1), Len(.Cells(iRow, 1)) - 4)
End If
varTmp = objDic.Item(.Cells(iRow, 1).Value)
Next iRow
End With
For iRow = 0 To objDic.Count - 1
n = 0
For i = 1 To lLastRow
If Cells(i, 1) = objDic.Keys(iRow) Then
s = Cells(i, 1)
n = n + 1
Select Case n
Case 1 To 9: sO = "_00"
Case 10 To 99: sO = "_0"
Case Is > 99: sO = "_"
End Select
Cells(i, 1) = s & sO & n
End If
Next i
Next iRow
End Sub
Так во второй части кода была привязка к первому столбцу листа.
Скрытый текст
Код
Sub apple3()
Dim lLastRow As Long, i As Long
Dim r As Range, n As Integer
Dim s As String, sO As String
Dim iRow As Integer, varTmp
Set r = Range("C1").CurrentRegion
lLastRow = r.Rows.Count
Dim cl As Long
Dim objDic As Dictionary
cl = r.Column
Set objDic = New Dictionary
With r
For iRow = 1 To .Rows.Count
If InStr(StrReverse(.Cells(iRow, 1)), "_") = 4 Then
.Cells(iRow, 1) = Left(.Cells(iRow, 1), Len(.Cells(iRow, 1)) - 4)
End If
varTmp = objDic.Item(.Cells(iRow, 1).Value)
Next iRow
End With
For iRow = 0 To objDic.Count - 1
n = 0
For i = 1 To lLastRow
If Cells(i, cl) = objDic.Keys(iRow) Then
s = Cells(i, cl)
n = n + 1
Select Case n
Case 1 To 9: sO = "_00"
Case 10 To 99: sO = "_0"
Case Is > 99: sO = "_"
End Select
Cells(i, cl) = s & sO & n
End If
Next i
Next iRow
End Sub
Sub dicnum()
Dim r&, c%, i&, t$, dic As Dictionary
r = 1
c = 3
Set dic = New Dictionary
For i = r To r + Cells(r, c).CurrentRegion.Rows.Count - 1
t = Split(Cells(i, c), "_")(0)
dic(t) = dic(t) + 1
Cells(i, c) = t & Format(dic(t), "_000")
Next i
End Sub
На всякий случай оставлю - так оно на пару порядков быстрее работать будет:
Код
Sub dicnum2()
Dim r&, c%, i&, t$, dic As Dictionary
r = 1
c = 3
Set dic = New Dictionary
arr = Cells(r, c).CurrentRegion
For i = 1 To UBound(arr)
t = Split(arr(i, 1), "_")(0)
dic(t) = dic(t) + 1
arr(i, 1) = t & Format(dic(t), "_000")
Next i
Cells(r, c).Resize(UBound(arr), 1) = arr
End Sub
Соблюдение правил форума не освобождает от модераторского произвола
Спасибо) но данный код не работает когда в ячейке словосочетание) К примеру "Красные яблоки" код удаляет слово яблоки и подставляет номер )) А последний вариант работает совершенно неправильно), если в первой ячейке находится текст то он его клонирует в ячейку С заменяя нужные значения И у меня немного посложнее задача, если делать сплит по _ то проблем нет но у меня это публичный прайс лист и я не могу использовать подчеркивание _001, у мня все в таком формате к сожалению "Красные яблоки 001" Но название идет со второй строки (с этим проблем нет) и с 3го столбца, уже начинаются проблемы в коде если текст имеется в столбцах 1 и 2 (( Прикрепил файл с таблицей
неправда, это вы его переписали, мой такого не делает
Цитата
brat155 написал: если в первой ячейке находится текст то он его клонирует
а кто сразу в примере показал, что работаем с умной таблицей? Короче
Скрытый текст
Код
Sub dicnum2()
Dim r&, c%, i&, t$, dic As Scripting.Dictionary, rng As Range, arr
Set dic = New Dictionary
Set rng = Range("Таблица2[NAME]") ' откуда, собственно, тянуть )))
arr = rng
r = rng.Row
c = rng.Column
For i = 1 To UBound(arr)
t = arr(i, 1)
If Right(t, 1) Like "#" Then t = Left(t, Len(t) - 4)
dic(t) = dic(t) + 1
arr(i, 1) = t & Format(dic(t), " 000")
Next i
Cells(r, c).Resize(UBound(arr), 1) = arr
End Sub