Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите распределить данные по массиву / 25 сообщений из 25, страница 1 из 1
28.11.2009, 23:45
    #36337279
Winner1
Winner1
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Добрый день. Помогите решить задучу.
Есть таблица в Excel (см вложение), набор цифр - это номер коробки.
Может быть более 2000 номеров.
Сканер сканирует штрих код с коробки и вносить номер в эту же таблицу.
Надо чтобы как только номер со сканера попал в ячейку (на пример в С1), Excel
сравнил бы введенный номер с номерами в массиве и переставил бы его в ту же
строку, где и исходный номер, пометив его зеленым цветом (столбец В).
Если такого номера в массиве нет, то его надо добавить в конец массива выделив
его красным цветом.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.12.2009, 21:56
    #36342118
Winner1
Winner1
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
HELP! HELP! HELP!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
02.12.2009, 08:21
    #36342407
SimpleC
SimpleC
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Winner1, держи код :)

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
Private Sub Worksheet_Change(ByVal Target As Range)

k =  0 

On Error GoTo ex


If Target <> Range("C1") Then GoTo ex



For i =  1  To  65000 



    If Range("A" & i) = "" Then Exit For


        If Range("A" & i).Value = Range("C1").Value Then
            
          
              Range("B" & i).Value = Range("C1").Value
          
          
               Range("B" & i).Font.ColorIndex =  50 
                   
          
          k = k +  1 
          
        
         End If
    
    
    
Next i



If k =  0  Then


    Range("A" & i) = Range("C1")

        Range("A" & i).Font.ColorIndex =  3 

    Range("B" & i).ClearContents


End If




ex:


End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
02.12.2009, 10:47
    #36342722
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Через Find надо делать, быстрее будет.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
02.12.2009, 10:52
    #36342737
SimpleC
SimpleC
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Hugo121, да можно и так... просто написал за пару минут первое , что пришло в голову :)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
02.12.2009, 12:19
    #36343022
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Сканер в конце ввода данных нажимает Энтер?
Если ДА, то так для начала:
Код: plaintext
1.
2.
3.
4.
5.
6.
Private Sub Worksheet_Change(ByVal Target As Range)
Addr = ActiveCell.Address(RowAbsolute:=False, columnabsolute:=False, ReferenceStyle:=xlA1)
If Addr <> "C2" Then Exit Sub
MsgBox  1 
End Sub

Вместо MsgBox 1 надо добавить обработку данных и возврат активной ячейки в С1.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
02.12.2009, 13:07
    #36343176
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Потестируй, повторы номеров не обрабатываются (копирует в первую найденную ячейку, поверх данных, если они уже есть):

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
Private Sub Worksheet_Change(ByVal Target As Range)
Addr = ActiveCell.Address(RowAbsolute:=False, columnabsolute:=False, ReferenceStyle:=xlA1)
If Addr <> "C2" Then Exit Sub
Set x = Columns( 1 ).Find(Cells( 1 ,  3 ), _
       LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) 'поиск совпадения
If Not x Is Nothing Then ' если нашли
    Cells( 1 ,  3 ).Activate
    Cells(x.Row,  2 ).Value = Cells( 1 ,  3 ).Value
    Cells(x.Row,  2 ).Font.ColorIndex =  50 
    Else ' если не нашли
    Cells( 1 ,  3 ).Activate
    Set blank_cell = Cells(Range("a1").SpecialCells(xlCellTypeLastCell).Row +  1 ,  1 )
    [C1].Copy blank_cell
    blank_cell.Font.ColorIndex =  3 
End If

End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
03.12.2009, 10:54
    #36345247
SimpleC
SimpleC
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Извиняюсь за оффтоп... А никто не знает как в качестве Target указывать не конкретную ячейку, а любую из ячеек определенного стобца, только не испоользуя при этом циклы? Я делаю это через циклы просто, иногда тупит из - за этого всё... Может как - то можно сразу указать свойством каким-нибудь или методом?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
03.12.2009, 10:56
    #36345255
Deggasad
Deggasad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
SimpleCИзвиняюсь за оффтоп... А никто не знает как в качестве Target указывать не конкретную ячейку, а любую из ячеек определенного стобца, только не испоользуя при этом циклы? Я делаю это через циклы просто, иногда тупит из - за этого всё... Может как - то можно сразу указать свойством каким-нибудь или методом?

ЫщЫ на форуме по словам Worksheet_Change и intersect (одновременно имеется ввиду)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
03.12.2009, 10:59
    #36345268
SimpleC
SimpleC
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Deggasad, ну на счёт Worksheet_Change момент очевидный.... А вот про intersect я не знал :) Видимо, в этом решение... Спасибо :)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
04.12.2009, 10:17
    #36347677
Winner1
Winner1
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Hugo121,

Большое СПАСИБО! Да, сканер сам вводит ENTER.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
04.12.2009, 10:21
    #36347685
Winner1
Winner1
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Hugo121,

На выходных все протестирую и отпишусь. А можно, как-то отслеживать, что одна и та же коробка
была отсканирована два раза и как-то об этом сразу же сообщать (цветом, звуком, банером и т.д.)?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
04.12.2009, 10:32
    #36347717
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
можно, как-то отслеживать - можно, надо в процедуру поиска добавить FindNext.
Вот пример, может сами приспособите:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
Private Sub SeachDataRange() 

iValue = Worksheets( 1 ).TextBox1.Value 

For Each iList In Worksheets 

Set iFinds = iList.UsedRange.Find(iValue, LookIn:=xlValues) 

If Not iFinds Is Nothing Then 

iFirstAddress = iFinds.Address 
        
Do 
iFindValue = iFindValue & vbCrLf & iList.Name & " - " & iFinds.Address & " - " & iFinds.Value 
iCount = iCount +  1  

Set iFinds = iList.UsedRange.FindNext(iFinds) 

Loop While Not iFinds Is Nothing And iFinds.Address <> iFirstAddress 
    
End If 

Next 

MsgBox iFindValue, , "Количество найденных совпадений : " & iCount 

End Sub
Т.е. ищем, пока адрес первого совпадения не совпадёт с адресом текущего следующего (круг завершён). Все промежуточные можно обрабатывать по вкусу.
Если мой код подойдёт, могу на след. неделе добавить, если надо будет ещё
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
04.12.2009, 11:14
    #36347842
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Чуток подумал...
Хотя, если в начальном списке повторов гарантированно нет (а мой код их не добавляет), то надо просто перед строкой Cells(x.Row, 2).Value = Cells(1, 3).Value поставить проверку на отсутствие записи в Cells(x.Row, 2).Value. Если уже есть - ругается и машет руками :)
Ну и наверное ещё надо проверить, что бы не было Cells(x.Row, 1).Font.ColorIndex = 3 - т.е. нашли запись, заведённую недавно сканером. Тогда FindNextом код усложнять не надо.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
04.12.2009, 13:06
    #36348222
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Вот что-то вроде такого:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
Private Sub Worksheet_Change(ByVal Target As Range)
Addr = ActiveCell.Address(RowAbsolute:=False, columnabsolute:=False, ReferenceStyle:=xlA1)
If Addr <> "C2" Then Exit Sub
Set x = Columns( 1 ).Find(Cells( 1 ,  3 ), _
       LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) 'поиск совпадения
If Not x Is Nothing Then ' если нашли
    Cells( 1 ,  3 ).Activate
    
        If Cells(x.Row,  1 ).Font.ColorIndex =  3  Then
        MsgBox "Номер уже сканирован, уникален!"
        Exit Sub
        End If

        If Cells(x.Row,  2 ).Value = "" Then
        Cells(x.Row,  2 ).Value = Cells( 1 ,  3 ).Value
        Cells(x.Row,  2 ).Font.ColorIndex =  50 
        Else
        MsgBox "Номер уже сканирован, есть в базе!!!"
        Exit Sub
        End If
        

    Else ' если не нашли
    Cells( 1 ,  3 ).Activate
    'MsgBox "Not Find!"
    Set blank_cell = Cells(Range("a1").SpecialCells(xlCellTypeLastCell).Row +  1 ,  1 )
    [C1].Copy blank_cell
    blank_cell.Font.ColorIndex =  3 
End If

End Sub

Сообщения отредактируйте на свой вкус.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
05.12.2009, 20:16
    #36350160
Winner1
Winner1
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Hugo121,

Большое СПАСИБО! Все работает как надо. Еще одна просьба, очень надо добавить два счетчика.
Коробки считаются партиями по 95-110 коробок, поэтому один счетчик считает количество коробок в партии и должен иметь возможность обнуления после подсчета партии. А второй счетчик просто считает общее количество коробок.
Если сделать обнуление не возможно, тогда общий счетчик можно поместить в ячейку С3, а счетчиков по партиям можно сделать несколько, чтобы они поочередно отображались в С5 - С6 - С7 - С....
Второй вариант даже лучше, так как дополнительно несет информацию о количестве партий.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.12.2009, 11:05
    #36351395
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
счетчиков по партиям можно сделать несколько - не делал, но несет информацию о количестве партий есть...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.12.2009, 11:10
    #36351408
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Как всегда, позже приходит мысль...
Строку
Код: plaintext
1.
        If [e3] >= [e4] Then [h3] = [h3] +  1 : [e3] =  0
надо дополнить
Код: plaintext
1.
         If [e3] >= [e4] Then MsgBox "Партия!": [h3] = [h3] +  1 : [e3] =  0
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.12.2009, 11:11
    #36351412
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Там две такие строки, извините.... (почему нельзя править....)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.12.2009, 09:44
    #36355758
Winner1
Winner1
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Hugo121,

Сообщение в этой ситуации не нужно. Но хотелось бы немного изменить форму представления, так как теряется важная информация: сколько же коробок в каждой партии мы посчитали. В прилагаемом файле я написал, что хотелось бы получить.
И если возможно еще два небольших дополнения:
- при появлении любого сообщения должен быть еще какой-нибудь звуковой сигнал;
- возможно ли, чтобы номера отсканированных коробок поочередно еще и заносились на лист 2 этой же книги?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.12.2009, 09:58
    #36358321
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Потести.
С заносом на второй лист легко и просто не получается, если и впрямь очень надо, можно подумать попозже.
Остальное сделал.
Вот только по звуку - он и так есть при появлении мессиджа (сделай погромче), как прикрутить какую-нибудь мелодию, так сразу в ВБА не знаю, искать надо...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.12.2009, 10:50
    #36358449
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
По заполнению второго листа:
Начало кода дополнить двумя строками:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
....
Addr = ActiveCell.Address(RowAbsolute:=False, columnabsolute:=False, ReferenceStyle:=xlA1)
If Addr <> "C2" Then Exit Sub

y = Sheets( 2 ).Cells( 1 ,  3 ).Value +  1    ' дополнить этими строками
Sheets( 2 ).Cells(y,  1 ).Value = [c1]     ' дополнить этими строками

Set x = Columns( 1 ).Find(Cells( 1 ,  3 ), _
       LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) 'поиск совпадения
If Not x Is Nothing Then ' если нашли
    Cells( 1 ,  3 ).Activate
.....

На втором листе в С1 формулу =COUNTA(A:A)
В русской версии вероятно =СЧЁТЗ(A:A)

Будет заносить все отсканированные номера подряд в столбец А второго листа (независимо от сообщений).
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.12.2009, 20:47
    #36359977
Winner1
Winner1
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Hugo121,

СПАСИБО! Сейчас буду тестить!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
13.12.2009, 16:08
    #36363611
Winner1
Winner1
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Hugo121,

Большое СПАСИБО, все работает кроме звуковых сигналов, но это в принципе не важно.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
16.12.2009, 15:23
    #36369723
Hugo121
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите распределить данные по массиву
Звуковые сигналы:
Код: plaintext
1.
2.
3.
4.
5.
Sub test()
iFileName = "c:\WINDOWS\Media\chimes.wav"
iMacroFunction = "SOUND.PLAY(,""" & iFileName & """)"
ExecuteExcel4Macro iMacroFunction
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите распределить данные по массиву / 25 сообщений из 25, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 494ms
Закрыть
start [/forum/topic.php?fid=61&tablet=1&tid=2178701]:
 0ms
get settings:
 8ms
get forum list:
 13ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 170ms
get topic data:
 8ms
get forum data:
 2ms
get page messages:
 45ms
get tp. blocked users:
 1ms
others: 243ms
total:  494ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]