» Excel VBA (часть 3)

Alexey87


Код:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim l
Set rgData = Range("C5:D70")
If Target.Cells.Count <> 1 Then Exit Sub
If Not (Application.Intersect(Target, rgData) Is Nothing) Then
With Worksheets(2)
l = Application.Match(Target.Value, .[A:A], 0)
If IsNumeric(l) = True Then Target = .Cells(l, 2)
End With
End If
End Sub

LaCastet, а возможно ли расширение Вашего кода для следующего случая:

Цитата:

в настоящее время имеется чередование полных и сокращенных названий на втором листе:
столбцы A,C,E,G с полными названиями
столбцы B,D,F,H со сокращенными названиями

Alexey87

Попробуйте так:

Код:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim l
Set rgData = Range("C5:D70")
If Target.Cells.Count <> 1 Then Exit Sub
If Not (Application.Intersect(Target, rgData) Is Nothing) Then
With Worksheets(2)
l = Application.Match(Target.Value, .[A:A], 0)
If IsNumeric(l) = True Then
Target = .Cells(l, 2)
Else
l = Application.Match(Target.Value, .[C:C], 0)
If IsNumeric(l) = True Then
Target = .Cells(l, 4)
Else
l = Application.Match(Target.Value, .[E:E], 0)
If IsNumeric(l) = True Then
Target = .Cells(l, 6)
Else
l = Application.Match(Target.Value, .[G:G], 0)
If IsNumeric(l) = True Then Target = .Cells(l, 8)
End If
End If
End If
End With
End If
End Sub

подскажите плиз по вба
есть 6000 файлов тхт, они лежат в папке c:\123
можно ли написать макрос, чтобы они встали под эту форму
http://rghost.ru/58031283
т.е. с самого первого файла списать название, потом указать его путь, что он лежит в c:\123
3 столбец можно не трогать.

Futurism
Так?

Код:
Sub GetNameTxtFiles()
Dim oFS As Object, oFl As Object, l&: l = 1

Set oFS = CreateObject("scripting.filesystemobject")
Set oFS = oFS.getfolder("C:\123")
For Each oFl In oFS.Files
If oFl.Name <> ThisWorkbook.Name Then
Cells(l, 1) = oFl.Name
Cells(l, 2) = oFl.Path
l=l+1
End If
Next
Set oFS = Nothing
End Sub

andrewkard1980
О Вы вернулись) Я уж думал, что вы больше никогда тут никому не поможете)
Все прекрасно вставилось

andrewkard1980
Раз вы вернулись, может и мне поможете)
Можно ли в этом наборе данных сделать так
http://rghost.ru/58131803
например, берется самая первая переменная , пусть цели , и упорядочивается от самого маленького значения, до самого большого. типа сортировка. В данном случае от 12-41
После, надо , вот там где переменная sex , посчитать сколько у нас единичек(n)=45 и сколько двоечек(m)=23. Потом надо вычислить сумму рангов для единичек для этой переменной цели:например, смотрим стоит единичка в столбце A3, у нее самое первое значение =14 вот ему присваивается первый ранг,ну там с с4 по с12 идут значения для единичек 1+8=9 рангов .(Rx) и так далее
Аналогично надо также по этой переменной вычислить сумму рангов только для двоечек.(Ry)
Когда это сделано, нужно чтобы эксель выcчитал эти формулы:
1. количество единичек*количество двоечек минус Rx +кол-во единиц*(кол-во единиц+1)/2
2.количество единичек*количество двоечек минус Ry +кол-во двоек*(кол-во двоек+1)/2
3. полученные ре-ты этих двух формул сложить

Чтобы было совсем просто, можно так показать.
первая формула
n=8
m=8
сумма рангов rx для n=46
считаем 8*8-46+8(8+1)/2=54
вторая формула

n=8
m=8
сумма рангов rу для m=90
считаем 8*8-90+8(8+1)/2=10
сложить сумму рангов по цели для n и m=54+10=64

и главное
вписать так
n(кол-во единиц) : m(кол-во двоек)| сумма рангов для пер.цели для n | сумма рангов для пер.цели для m | сложить сумму рангов по цели для n и m
переменная цели
остальные переменные

Сможете помочь?

Fsp050
Помочь то можно, но из Вашей постановки не совсем понятно что до чего. Было бы понятнее, если бы Вы расписали полностью шаги для первой цели. Без упрощения.

смотрите. давайте на простом примере.
вот в этом файле
столбец С
у нас какие -то значения они идут хаотично. выборка это понятно 1-муж., 2 -жен.
8 муж., 8 жен.
Программа должна их упорядочить, как в столбце D что б шли попорядку

в столбце E мы для первой группы расставляем ранги. Из столбца Д, мы видим, что 3 и 4 ранги относятся к первой группе. значит напротив них в столбце Е цифре 3 ставим 1 ранг, а цифре 4 второй. смотрим опять столбец Д там цифра 5 относится ко второй группе, значит в столбце F напротив нее ставим 3 ранг.Цифра 6 из столбца Д относится к 1 группе, поэтому напротив нее ставим 4 ранг. цифра 7 из столбца д относится к первой группе и ей ставится 5 ранг, а вот цифра 8 относится к первой группе и ей ставится 6 ранг, цифра 9 относится ко второй группе и ей ставится 7 ранг
аналогичным образом так приписываются ранги.
потом они суммируются
сумма рангов для первой группы равна 46, а для второй= 90

далее вычисляем Ux =кол-во людей в первой группе умножить на кол-во людей во второй группе- 46(сумма рангов) +кол-во людей в первой группе умножить на (кол-во людей в первой группе+1)2=54

высчитаем Uy= кол-во людей в первой группе умножить на кол-во людей во второй группе- 90(сумма рангов второй группы ) +кол-во людей во второй группе умножить на (кол-во людей второй группы+1)/2=10

затем 54+10=64

вот сам исходные файлик, где все это вручную посчитано
http://rghost.ru/58178819

все вычисления программы, начиная со столбца Д лучше чтобы шли внутри нее. а на выходе появлялись, данные, которые в 21 строке

Подскажите, плиз, паттерн для objRegExp. Требуется из строки, вида "бла-бла-[трали-вали]-бла-бла-[тили-тили]-бла-бла" удалить всё, что заключено в скобки, включая сами скобки. Т.е. в итоге должно получиться "бла-бла--бла-бла--бла-бла".

Maximus777

Код:
Public Function MyReplace(S, aPattern, aReplace As String) As String

Dim objRE As VBScript_RegExp_55.RegExp
Set objRE = New VBScript_RegExp_55.RegExp

objRE.Global = True
objRE.Pattern = aPattern

MyReplace = objRE.Replace(S, aReplace)

End Function

Vitus_Bering
спасибо! Работает! В вызове только запятой разделяются параметры, но это мелочи.

Maximus777
Да, запятые, если программный вызов, а на листе - точка с запятой.

Fsp050
Пробуйте:

Код:
Option Explicit
Sub GetSumRank()
Dim iCl%, iLCl%, iRw%, iLRw%, iSex%, lSum1&, lSum2&, iRank%
Application.ScreenUpdating = False
With Worksheets(1)
iLCl = .Cells(1, .Columns.Count).End(xlToLeft).Column
iLRw = .Cells(.Rows.Count, 3).End(xlUp).Row
For iCl = 3 To iLCl
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Cells(1, iCl), Order:=xlAscending
With .Sort
.SetRange Range(Cells(1, 1), Cells(iLRw, iLCl))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
iRank = 1
lSum1 = 0
lSum2 = 0
For iRw = 2 To iLRw
iSex = .Cells(iRw, 1).Value
Select Case iSex
Case 1
lSum1 = lSum1 + iRank
Case 2
lSum2 = lSum2 + iRank
End Select
iRank = iRank + 1
Next iRw
.Cells(iLRw + 3, iCl).Value = lSum1
.Cells(iLRw + 4, iCl).Value = lSum2
Next iCl
End With
Application.ScreenUpdating = True
End Sub

andrewkard1980
Вы как всегда вы на высоте, но можете все-таки сделать на другом листе как он ранги считает. Т.е. на втором листе
на подобии, как я показал в том файле
но уже для переменной цели и остальных .

Я к тому, что мне кажется есть небольшая погрешность. Сейчас просто я в универе и имею доступ к программе statistica
Она считает, что по переменной цели
1 группа ранг 1399
2 группа ранг 946

у Вас чуть меньше
1394
952

Просто я хочу посмотреть, как он считает , может я скорретирую чуть-чуть. Буду как всегда Вам весьма благодарен.

Fsp050
Мне тоже интересно, посчитайте вручную для переменной Цели и напишите результат. Посмотрим.
Как макрос считает, к стати, видно по коду:

Код:
iRank = 1
For iRw = 2 To iLRw
iSex = .Cells(iRw, 1).Value
Select Case iSex
Case 1
lSum1 = lSum1 + iRank
Case 2
lSum2 = lSum2 + iRank
End Select
iRank = iRank + 1

andrewkard1980
ладно с этим разберемся. Там несущественное различие. Можете лучше ещё в код сделать, чтобы когда сумма рангов была посчитана, ты вычислялась формула
Например, ячейка b72(там итоговая сумма рангов) и b73(там вторая сумма рангов) надо, чтобы именно через vba высчитывалась эта формула
в ячейке b74 =количество единиц * кол-во двоек (из столбца А)-b72+кол-во единиц*(кол-во единиц+1)/2 = 45*23-1394+45(45+1)/2=676
в ячейке b75 =количество единиц * кол-во двоек (из столбца А)-b73+кол-во двоек*(кол-во двоек+1)/2=45*23-952+23*(23+1)/2=359
Ну, с учетом того, что в будущем в этом файле будут сотни чисел. и значения могут быть и в ячейке b172 и так далее.

Всем привет!
Не знаете, почему так может быть? Только с Excel VBA такие траблы, в автокаде например все ок.
офис 2013
https://www.dropbox.com/s/moxew2r10gwyzqh/vba.jpg

Есть ли способы работать с XML быстрее, чем c использованием XPath? Использование SAX не пойдет, ибо требуется не последовательное чтение.

Используй RegExp, купи платформу Haswell-E.

Fsp050
Тогда как то так:

Код:
Sub GetSumRank()
Dim iCl%, iLCl%, iRw%, iLRw%, iSex%, lSum1&, lSum2&, iRank%, lNum1%, lNum2%
Application.ScreenUpdating = False
With Worksheets(1)
iLCl = .Cells(1, .Columns.Count).End(xlToLeft).Column
iLRw = .Cells(.Rows.Count, 3).End(xlUp).Row
For iCl = 3 To iLCl
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Cells(1, iCl), Order:=xlAscending
With .Sort
.SetRange Range(Cells(1, 1), Cells(iLRw, iLCl))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
iRank = 1
lSum1 = 0
lSum2 = 0
lNum1 = 0
lNum2 = 0
For iRw = 2 To iLRw
iSex = .Cells(iRw, 1).Value
Select Case iSex
Case 1
lSum1 = lSum1 + iRank '1394
lNum1 = lNum1 + 1 '45
Case 2
lSum2 = lSum2 + iRank '952
lNum2 = lNum2 + 1 '23
End Select
iRank = iRank + 1
Next iRw
.Cells(iLRw + 3, iCl).Value = lSum1
.Cells(iLRw + 4, iCl).Value = lSum2
.Cells(iLRw + 5, iCl).Formula = "=" & lNum1 & "*" & lNum2 & "-" & lSum1 & "+" & lNum1 & "*(" & lNum1 & "+1)/2" ' = 45*23-1394+45(45+1)/2=676
.Cells(iLRw + 6, iCl).Formula = "=" & lNum1 & "*" & lNum2 & "-" & lSum2 & "+" & lNum2 & "*(" & lNum2 & "+1)/2" ' = 45*23-952+23*(23+1)/2=359
Next iCl
End With
Application.ScreenUpdating = True
End Sub

andrewkard1980
нет слов Очень круто.
кстати, а почему у нас ранги неверно посчитались тоже стало ясно. Дело в том, что когда много повторяющихся чисел, алгоритм присвоение ранга меняется. Вот в чем было дело
Если какое-то значение встречается несколько раз , то ранг этого значения будет равен среднему арифметическому из первоначальных рангов этого значений.
например как на картинке

Цифра 20 тут встречается 9 раз
суммируем первоначальные ранги этого значения (8+9+10+11+12+13+14+15+16=108) и делим на 9 =12 и всем двадцаткам присваиваем ранг 12
можете, пожалуйста, там в коде прописать, что если цифра встречается больше 5 раз включительно, то считать ранг таким образом, как я сейчас показал, тогда данные будут так же как в статистике

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

Сумма рангов для группы 1
Сумма рангов для группы 2
Ux
Uy

Может кто набросать пример демонстрации скачивания файла с прогрессом?

Господа, с неустановленного момента во всех макросах в Personal.xlsb Rows изменился на RowS.

Любые попытки изменить обратно RowS на Rows пресекаются в корне. Т.е. как только жму Ctrl+S или кнопку "Сохранить" (макрос) тут же ВСЕ вхождения Rows меняются на RowS. Просмотрел все макросы (их у меня около 30-40): везде, где было Rows, стало RowS.

Ни с какими другими служебными словами подобной ерунды не возникало.
Насколько я знаю, регистр букв имеет значение в некоторых языках программирования (например в C#), но в VBA это никакого значения (кроме визуального восприятия) не имеет. Но, как-то неправильно, чтобы регистр букв самопроизвольно менялся...
В чем может быть проблема? Куда копать?

MS Excel 2010 (c SP2).

Smog
Может есть смысл поставить английскую версию, тут видимо не правильно отображается перевод с (не уверен что за язык) китайского.

andrewkard1980
а мне не поможите))

Fsp050
Там много надо дописывать, сейчас времени нет, позже чуть попробую.

andrewkard1980

Цитата:

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

Дело в том, что какое-то время все было в порядке.... потом по неизвестной причине стало так

andrewkard1980
Спасибо Вам, я знал, что Вы поможите)

Подскажите, можно ли такое реализовать в экселе. выделяешь столбец с перемееной жмешь кнопку,



а он на выходе выдает именно такие графики


где mean это среднее
mean+se среднее и стандартная ошибка(это в принципе не обязательно)
mean+sd это среднее и стандартное отклонение
outlier выброcы
extremes крайние значения
median это медиана
25-75 это это диапозон между 25-75 персентелем
ну и линия вне выбросов.
Просто таких графиков в экселе нет.