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

Подскажите пожалуйста как это сделать?

Здравствуйте, скажите пожалуйста как скрипту задать несколько условий?  
 
Вот код:  
 
Private Sub Недели()  
Dim a(), i&, bb&, cc&, dd&, ee&, ff&, gg&  
a = Sheets("Практики из плана").UsedRange.Value  
ReDim b(1 To 5, 1 To 2)  
For i = 3 To UBound(a)  
Select Case a(i, 2)  
Case 6  
bb = bb + 1: b(bb, 1) = a(i, 5): b(bb, 2) = a  
End Select  
 
Next  
[g34].Resize(bb, 1) = b
End Sub  
 
в нем условие если в столбце 2 есть значение "6" то записать его, как задать к примеру еще и значение от 1 до 9 с учетом если строить что то типа  
 
Private Sub Недели()  
Dim a(), i&, bb&, cc&, dd&, ee&, ff&, gg&  
a = Sheets("План").UsedRange.Value  
ReDim b(1 To 65, 1 To 2)  
ReDim c(1 To 65, 1 To 2)  
ReDim d(1 To 65, 1 To 2)  
ReDim e(1 To 65, 1 To 2)  
ReDim f(1 To 65, 1 To 2)  
ReDim g(1 To 65, 1 To 2)  
ReDim h(1 To 65, 1 To 2)  
ReDim n(1 To 65, 1 To 2)  
ReDim o(1 To 65, 1 To 2)  
For i = 6 To UBound(a)  
Select Case a(i, 2)  
Case 1  
bb = bb + 1: b(bb, 1) = a(i, 2): b(bb, 2) = a(i, 3)  
Case 2  
cc = cc + 1: c(cc, 1) = a(i, 2): c(cc, 2) = a(i, 3)  
Case 3  
dd = dd + 1: d(dd, 1) = a(i, 2): d(dd, 2) = a(i, 3)  
Case 4  
ee = ee + 1: e(ee, 1) = a(i, 2): e(ee, 2) = a(i, 3)  
Case 5  
ff = ff + 1: f(ff, 1) = a(i, 2): f(ff, 2) = a(i, 3)  
Case 6  
gg = gg + 1: g(gg, 1) = a(i, 2): g(gg, 2) = a(i, 3)  
Case 7  
hh = hh + 1: h(hh, 1) = a(i, 2): h(hh, 2) = a(i, 3)  
Case 8  
nn = nn + 1: n(nn, 1) = a(i, 2): n(nn, 2) = a(i, 3)  
Case 9  
oo = oo + 1: o(oo, 1) = a(i, 2): o(oo, 2) = a(i, 3)  
End Select  
 
Next  
[b8].Resize(bb, 2) = b
[b8].Offset(bb).Resize(cc, 2) = c
[b8].Offset(bb + cc).Resize(dd, 2) = d
[b8].Offset(bb + cc + dd).Resize(ee, 2) = e
[b8].Offset(bb + cc + dd + ee).Resize(ff, 2) = f
[b8].Offset(bb + cc + dd + ee + ff).Resize(gg, 2) = g
[b8].Offset(bb + cc + dd + ee + ff + gg).Resize(hh, 2) = h
[b8].Offset(bb + cc + dd + ee + ff + gg + hh).Resize(nn, 2) = n
[b8].Offset(bb + cc + dd + ee + ff + gg + hh + nn).Resize(oo, 2) = o
 
End Sub  
 
получается если к примеру не будет числа 3 в столюце то запись массивов прекратится с ошибкой хоть и если будет массивы под номером 4.

Здравствуйте, помогите со скриптом, на листе "Приложение к диплому (оборот)" есть кнопка заполняет все верно но нужно както в этот цикл добавть еще одну задачу, заключатся должна в следующем вот в этом коде она записывает с последнего столбца массивы из листа "План", как сделать так чтобы она дублировала строку в массиве и добовляла в конец строки "(КР)" какую строку дублировать она должна смотреть есть ли данные в столбце 8 листа "План".  
 
Вот к примеру:  
 
Прикладная механика  
Программирование микропроцессорных устройств  
Электротехника и электропривод  
Элементы автоматики  
Материаловедение  
 
запись выгледит так но в столце 8 в строчке с прекладной миханикой стоит значение и запись должна выглядеть так:  
 
Прикладная механика  
Прикладная механика (КР)  
Программирование микропроцессорных устройств  
Электротехника и электропривод  
Элементы автоматики  
Материаловедение  
 
как такое реализовать подскажите пожалуйста.  
 
 
http://narod.ru/disk/54044099001.cd366ccb045f26d0e3d4da16757f17fb/%D0%9A%D0%B7-611.rar.html

Скриптиком работать незахотело) вставил в ячеку растенул и потом в VBA вставил код этому листу и книге пробывал)  
 
спасибо The_Prist за формулу, по ней все впринципе хорошо работает) только вот сталкнулся с проблемой, возникла надобность подгрузки других книг, т. е. я поменял там в коде название листа на название файла и в общем получается что формула работает но какбы берет не последнюю дисциплину, а первую.  
 
Попробывал с того файла лист прикрутить к книге где работает формула, и вновь формула правельно заработала.  
 
В чем может быть причина?

Спасибо) дейсвительно первый раз услышал  
 
А можно чтонибуть такое добавить в нее, вот к примеру физическая культура, в ней идет в 6 семестре зачет, а в 5 оценка, можно какнибуть сделать чтобы выставлялась оценка если в последнем зачет ну или если есть где последняя оценка то оценку, а если их нету то зачет

Ну в общем попробывал и выходит в каждой ячейке #ЗНАЧ! но в одной записывается ФИО хотя должна ити запись оценки

Спасибо, сейчас попробую, тут главное не VBA а работа

Здравствуйте,  помогите пожалуйста со скриптом, задача похожа на ВПР но ВПР с ней до конца не справится) в общем нужно чтобы  последняя одинаковая в строке ячейка  записывала данные с этого столбца в зависимости названия строки, ну по порядку.    
 
В этом файле есть несколько листов, нужно чтобы по нажатию кнопки или еще как то, было заполнение оценок в листе «Приложение к диплому (оборот)» заполнятся должны следующим образом: К примеру, будет кнопка.    
 
Нажимаем на кнопку она смотрит что стоит в ячейке B4 листа «Приложение к диплому (титул)» ну там где фамилии. После чего выделяет для себя на листе «Оценки» строчку с этой фамилией, ну принцип ВПР, потом она уже начинает сверять данные «Приложения к диплому (оборот)» с «Оценками» к примеру если видит первая строчка «Физическая культура» то на листе оценки ищет в строке все ячейки с данными «Физическая культура» и выбирает из них последний и. д.    
 
 
 
http://narod.ru/disk/53373497001.031956762747e4081509c8c6ab71d267/Pril1.rar.html

Здравствуйте, а скажите пожалуйста где я могу найти все свои темы на форуме? поском только некоторые получилось, а те которые нужны немогу найти(

Извените, а вот допустим понадобится убрать шаг цикла как это сделать?)  
 
Ну к примеру чтобы записался 1 массив затем пропустил столбец и началась запись нового.

аа спасибо, сам незаметил(

Посмотрите пожалуйста, в чем может быть проблема, на пол пути ошибка.  
 
http://narod.ru/disk/52398883001.56de18ba54a863071002e4d22e55170a/%D0%9A%D0%B7-61%D0%BA%D0%B0%D1%80%D1%82%D0%BE%D1%87%D0%BA%D0%B0.rar.html

Спасибо

Скажите пожалуйста, для чего нужен словарь?  
 
Dim oDict As Object, cs As Double  
 
Set oDict = CreateObject("Scripting.Dictionary")  
oDict.CompareMode = vbTextCompare

Спасибо, все работает)

Вот пример не на файле)  
с которого листа читается скрипт, данные такого типа:  
123  
123  
123  
123  
123  
123  
123  
123  
123  
123  
123  
123  
Как скрипт записывает на новый:  
123  123  123  123  
123  123  123  123  
123  123  123  123  
А нужно чтобы писалось так:  
123  123  123  123  123  123  123  123  123  123  123  123

Здравствуйте вот есть код:  
 
Private Sub CommandButton1_Click()  
Dim a(), i As Byte, ii As Long, iii As Long, x As Byte  
Dim oDict As Object, cs As Double  
 
Set oDict = CreateObject("Scripting.Dictionary")  
oDict.CompareMode = vbTextCompare  
 
a = Sheets("Лист1").UsedRange.Value  
 
 
For i = 2 To 120 Step 12  
ReDim b(1 To 12, 1 To 1)  
iii = 0  
x = x + 1  
For ii = 6 To UBound(a)  
If Len(a(ii, 68)) > 0 Then  
If InStr(a(ii, 4) & a(ii, 3), x) Then  
iii = iii + 1  
b(iii, 1) = a(ii, 2)  
Else  
End If  
Else  
End If  
Next  
Cells(2, i).Resize(12, 1) = b  
Next  
End Sub  
 
Вот собственно проблема: Этот скрипт берет из другого листа массив разбивая его на несколько частей, но это не важно, записывает его в первую строку листа но в столбец эти куски массива, скажите пожалуйста как сделать чтобы эти массивы записывались в строчку?

Спасибо, все помогло

А скажите пожалуйста, вот код от 20.05.2012, 19:09 он выполняеся на определенном листе, перенесу я его на гланый и как задать ему на каком листе выполнять?  
 
Если неперенося, делал вот так    
 
Private Sub Workbook_Open()  
Call Практики  
End Sub  
Private Sub Workbook_Open()  
Call Недели  
End Sub  
 
вылетала все таже ошибка, в теме ее упоминал, а вот когда просто    
 
Private Sub Workbook_Open()  
Call Практики  
End Sub  
 
то ошибок небыло, но не работала тоже, при открытии книги, но нужно выполнение 2х кнопок

А выполнив все это кнопки удалить можно будет?

У меня же не макросы, имени у скрипта нету(

http://narod.ru/disk/49868124001.a1a4c0c7c465fa7e5a6eee47562b00bc/А-71карточка%20NEW.rar.html  
 
То что дописывал прилось убрать, сохранить неполучалось, вот там 2 кнопки есть нужно чтобы вместо них, скрипт автоматически при открытии файла выполнял скрипт.

Попробывал каждый но выдает ошибку:  
 
Compile error:  
Ambigous name detected: Worksheet_Calculate  
 
Может я както не так ставляю?  
В листе где нужно его выполнение вставлюя так:  
 
Private Sub Worksheet_Calculate()  
Dim a(), i&, bb&, cc&, dd&, ee&, ff&, gg&  
a = Sheets("Практики из плана").UsedRange.Value  
ReDim b(1 To 5, 1 To 2)  
ReDim c(1 To 5, 1 To 2)  
ReDim d(1 To 5, 1 To 2)  
ReDim e(1 To 5, 1 To 2)  
ReDim f(1 To 5, 1 To 2)  
For i = 3 To UBound(a)  
Select Case a(i, 2)  
Case 2  
bb = bb + 1: b(bb, 1) = a(i, 5): b(bb, 2) = a  
Case 4  
cc = cc + 1: c(cc, 1) = a(i, 5): c(cc, 2) = a  
Case 6  
dd = dd + 1: d(dd, 1) = a(i, 5): d(dd, 2) = a  
Case 8  
ee = ee + 1: e(ee, 1) = a(i, 5): e(ee, 2) = a  
Case 10  
ff = ff + 1: f(ff, 1) = a(i, 5): f(ff, 2) = a  
End Select  
 
Next  
[g34].Resize(bb, 1) = b
[g34].Offset(bb).Resize(cc, 1) = c
[g34].Offset(bb + cc).Resize(dd, 1) = d
[g34].Offset(bb + cc + dd).Resize(ee, 1) = e
[g34].Offset(bb + cc + dd + ee).Resize(ff, 1) = f
End Sub

Извените, а чем они отличаются?

Здраствуйте,  вот у меня есть кнопка в которой скрипт, служит ждя заполнения неких ячеек по нажатию, скажите пожалуйста куда записать скрипт чтобы кнопки небыло, работать начинал он на автомате.

Помогите пожалуйста с этим сообщением 14.05.2012, 22:04 )

Хотя все получилось назвав в плане первую ячейку последнего столбца

От балды записал еще и вот так:  
 
Private Sub CommandButton1_Click()  
Dim a(), i&, bb&, cc&, dd&, ee&, ff&, gg&  
a = Sheets("План").UsedRange.Value  
ReDim b(1 To 65, 1 To 2)  
ReDim c(1 To 65, 1 To 2)  
ReDim d(1 To 65, 1 To 2)  
ReDim e(1 To 65, 1 To 2)  
ReDim f(1 To 65, 1 To 2)  
ReDim g(1 To 65, 1 To 2)  
For i = 6 To UBound(a)  
LastColumn = Sheets("План").UsedRange.Value  
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column  
Select Case a(i, LastColumn)  
Case 1  
bb = bb + 1: b(bb, 1) = a(i, 2): b(bb, 2) = a(i, 7)  
Case 2  
cc = cc + 1: c(cc, 1) = a(i, 2): c(cc, 2) = a(i, 7)  
Case 3  
dd = dd + 1: d(dd, 1) = a(i, 2): d(dd, 2) = a(i, 7)  
Case 4  
ee = ee + 1: e(ee, 1) = a(i, 2): e(ee, 2) = a(i, 7)  
Case 5  
ff = ff + 1: f(ff, 1) = a(i, 2): f(ff, 2) = a(i, 7)  
Case 6  
gg = gg + 1: g(gg, 1) = a(i, 2): g(gg, 2) = a(i, 7)  
End Select  
 
Next  
[b8].Resize(bb, 2) = b
[b8].Offset(bb).Resize(cc, 2) = c
[b8].Offset(bb + cc).Resize(dd, 2) = d
[b8].Offset(bb + cc + dd).Resize(ee, 2) = e
[b8].Offset(bb + cc + dd + ee).Resize(ff, 2) = f
[b8].Offset(bb + cc + dd + ee + ff).Resize(gg, 2) = g
 
End Sub  
 
После чего весь Excel виснет))) приходится перезагружать

А хотя нет не помогло)) ругается на [b8].Resize(bb, 2) = b
 
Щас попробую понять ваше последнее сообщение 17.05.2012, 04:48