Страница: 1 |
|
Вопрос: Замена наименования товара кодом в VBA
|
Добавлено: 17.02.09 01:24
|
|
Автор вопроса: Григорий
|
Всем доброе время суток!
В столбец A вводятся названия товаров
скрепки = 1 ( 1,2,3 - код товаров)
тетради = 2
карандаши = 3
как сделать при помощи VBA , чтобы при введении
товаров в A в столбце B автоматически выводился код товаров
заранее благодарен
Ответить
|
Номер ответа: 1 Автор ответа: AngryBadger
Вопросов: 33 Ответов: 245
|
Профиль | | #1
|
Добавлено: 17.02.09 10:36
|
Option Explicit
Option Base 1
Function КАНЦЕЛЯРИЯ(Numb As Integer) As String
Dim MyArr As Variant
On Error GoTo Over
MyArr = Array("скрепки", "тетради", "карандаши"
КАНЦЕЛЯРИЯ = MyArr(Numb)
Over:
If КАНЦЕЛЯРИЯ <> Empty Or Numb = Empty Then
Exit Function
Else
КАНЦЕЛЯРИЯ = "Нет такого!"
End If
End Function
Добавь в MyArr все что нужно, и протяни по столбцу "B" Формулу =КАНЦЕЛЯРИЯ(A1)
Ответить
|
Номер ответа: 3 Автор ответа: AngryBadger
Вопросов: 33 Ответов: 245
|
Профиль | | #3
|
Добавлено: 17.02.09 11:04
|
Option Explicit
Option Base 1
Function КАНЦЕЛЯРИЯ(What As String) As String
Dim MyArr() As Variant
Dim item As Variant
Dim i As Integer
MyArr = Array("скрепки", "тетради", "карандаши"
i = 0
For Each item In MyArr
i = i + 1
If LCase( CStr(item)) = LCase(What) Then
КАНЦЕЛЯРИЯ = i
Exit Function
End If
Next item
End Function
Добавь в MyArr все что нужно, и протяни по столбцу "B" Формулу =КАНЦЕЛЯРИЯ(A1)
Ответить
|
Номер ответа: 6 Автор ответа: AngryBadger
Вопросов: 33 Ответов: 245
|
Профиль | | #6
|
Добавлено: 17.02.09 18:07
|
как вставить в MyArr коды товаров
MyArr = Array("скрепки", "тетради", "карандаши","и через запятую в кавычках вписывай все что хочешь" Вписывай по порядку, как у тебя номера идут.
Можно ли использовать функцию ЕСЛИ без применения формул EXEL
Можно.
if ....... then
'......
elseif ... then
'......
elseif ... then
'и так далее
End if
А чтобы заработало то, что я написал, тебе нужно правой кнопкой мыши щелкнуть по названию листа, выбрать в менюшке "Исходный текст", потом вставить туда это:
Option Explicit
Option Base 1
Function WrGoods(What As String) As Integer
Dim MyArr() As Variant
Dim item As Variant
Dim i As Integer
MyArr = Array("скрепки", "тетради", "карандаши"
i = 0
For Each item In MyArr
i = i + 1
If LCase( CStr(item)) = LCase(What) Then
WrGoods = i
Exit Function
End If
Next item
End Function
Private Sub Worksheet_Change( ByVal Target As Range)
If Selection.Cells.Count = 1 Then
If Not Intersect(Range(Cells(1, 1), Cells(65536, 1)), Target) Is Nothing _
And WrGoods(Target.Value) <> 0 Then
Cells(Target.Row, 2) = WrGoods(Target.Value)
End If
End If
End Sub
Ответить
|
Страница: 1 |
Поиск по форуму