» Excel VBA (часть 2)

Спасите,не работает!
ЛIf InStr(Quantity, "-") = True Then
Quant = (Quantity.Value + Quantity.Value * 2)
ElseIf InStr(Quantity, "-") = False Then
Quant = Quantity.Value
End If
Когда вношу положительное работает, а если отрецательное совсем ничго не выдает(
Help!!!

ValentinaK что Вы себе голову морочите!? :-)
есть такая функция ABS (рекомендую в учебнике математике ознакомится)
она же - модуль числа - возращает положительное число всегда.
Quant = ABS(Quantity.Value)

Спасибо справилась, правда другим способом:
If Quant = True Then
'If Quant > 0 Then
'Quant = Quantity.Value
'ElseIf Quant <= 0 Then
'Quant = (-Quant * 2 + Quant)
' End If
Но возьму на заметку!
А можно еще вопрос?
У меня еще проблема:
Есть 2 окна, если их не заполнили выходит ошибка.
Dim NamePr As Variant
NamePr = NameOfPr.Text
If NamePr = " " Then (И Not Empty И True пробовала)
Unload Me
GettingKit.Show
GettingKit.Label28.Caption = NamePr
Else: MsgBox "please insert Data"
End If
Он не принимает, чтобы не ввела показывает MsgBox
ЖДУ ПОМЩИ!!!

ValentinaK
Если у Вас NameOfPr - это, например, имя TextBox-а, то проверить, заполнен он или нет, исключая пробелы, можно так:
Код: If Trim(NameOfPr.Text) = "" Then ...

Вопрос:
Есть книга в ней нное кол-во листов...
Мне необходим например последний и из него вытащить данные из определенных ячеек в текстовый файл формата ЦСВ ...
Все данные этого листа, но с определенных колонок!
Как это сделать методом макроса?

Kilich

Цитата:

Мне необходим например последний

Некорректно. Что значит последний? Последний ярлычок в списке листов?


Цитата:

Public Const Dop = "base.csv"

Sub Macro()
Data Dop
End Sub

Public Sub Data(ByVal NameBook As String)
Dim WrkPath As String, Found As Boolean, w As Object
Dim WrkBook As Object, fs As String
Application.ScreenUpdating = False
Set WrkBook = ThisWorkbook
Found = False
For Each w In Workbooks
If VBA.UCase(w.Name) = VBA.UCase(NameBook) Then
Found = True
Application.Workbooks(Dop).Activate
Cells.Select
Selection.Clear

Windows("123.XLS").Activate
Sheets("ПоследнийЛист").Select
Cells.Select
Selection.Copy
Windows("base.csv").Activate
Sheets("Лист2").Select
ActiveSheet.Paste
ActiveSheet.Shapes.SelectAll
Selection.Cut
Range("a1").Select
Windows("123.XLS").Activate
Sheets("ПоследнийЛист").Select
Range("a1").Select
Sheets("Диалог").Select
Windows("base.csv").Activate
Exit For
End If
Next w
WrkPath = ThisWorkbook.Path
fs = WrkPath + "\" + NameBook

If Not Found Then
If fs <> Empty Then
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="base.csv", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End If
End If

WrkBook.Activate
Range("a1").Select
Windows("123.XLS").Activate
Sheets("ПоследнийЛист").Select
Range("B3:H13").Select
Selection.Copy
Range("B3").Select
Windows("base.csv").Activate
Sheets("Лист2").Select
Range("a1").Select
ActiveSheet.Paste
Windows("123.XLS").Activate
Sheets("ПоследнийЛист").Select
Range("a1").Select
Sheets("Лист1").Select
Windows("base.csv").Activate
Range("a1").Select
End Sub

Разберётесь?

Kilich

Код: Sub WriteLastSheetToFileTXT()
Dim Row1 As Long, Row2 As Long, i As Long
Dim Sb As Worksheet

Set Sb = ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
Open "C:\Test1.txt" For Output As 1
Row1 = Sb.UsedRange.Row
Row2 = Row1 + Sb.UsedRange.Rows.Count - 1
MsgBox "Сохраняем Столбцы А и С, строки от " & Str(Row1) & " до " & Str(Row2) & _
" в файл C:\Test1.txt"
For i = Row1 To Row2
Print #1, Sb.Cells(i, "A").Value, Sb.Cells(i, "C").Value
Next i
Close 1 ' Закроем файл
End Sub

ivas
Попытаюсь разобраться!, но не знаю по чем судить - по коду SERGE_BLIZNUK
продемонстрировал короче код может легче... В любом случае буду разбираться с обеими вариантами - какой более подойдет!

Спасибо что отозвались - буду править свою оборотку.

Подскажите, как вставить колонку. Процедуркой перебираю файлы xls. В открываемые файлы мне в первом листе нужно вставить колонку (пустую) между третьей и четвертой колонкой, но что то не получается, как это сделать?

VanoZZZ
Цитата:

между третьей и четвертой колонкой

Если я правильно понял - то это столбец. Колонки знаю только газовые...


Цитата:

Range("D1").Select
Selection.EntireColumn.Insert

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

Добрый день.

Не подскажите пример кода, который анализирует данные в ячейке на предмет наличия определённых символов. Что-то типо условий starts with, contains или ends with. Анализироваться будут ячейки, в которых введены даты в формате дд.мм.гггг

Хочу осуществить сею задумку: в ячейки вводятся важные даты, и хочется сделать своеобразную проверку на ошибки. Так как даты в основном текущие (отличаются только днями) сделать проверку ввода месяца, года в формате дд.мм.гггг. Проверка самая простая - если введёный месяц отличается от текущего то выскакивает месджбокс.

nopoxz
может обойдётесь Данные - Проверка - Дата... сообщение об ошибке...
если же не устроит - тогда надо писать макрос,
цепляться на Worksheet_Change(ByVal Target As Range)
и там анализировать что угодно...

Ребята помогите!!!
вопрос такой:
1) у меня есть userform с label и spreadsheet и нужно чтоб при нажатии кнопки commandbutton были бы распечатаны данные с userform. Воспользовалась кодом:
userform1.PrintForm
печатает мне spreadsheet в маленьком формате и только те строки которые видны на экране . как сделать больше формат и чтобы печатал весь список?
2)когда пользуешься userform , нет озможности пользоваться excel, можно ли с этим что либо сделать - тоесть пользоваться Excel не зарывая userform
пасибки

SERGE_BLIZNUK

Worksheet_Change(ByVal Target As Range) - такой макрос я начинаю писать, но вот какими командами анализировать??

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

    

nopoxz
ну, я не знаю, что именно Вы хотите проверить и что Вы хотите сделать, если дата, например, не попадает в текущий месяц и текущий год...
вот образец:

Код:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A:A,D1:D10]) Is Nothing Then
Application.EnableEvents = False
Dim iCell As Range
For Each iCell In Intersect(Target, [A:A,D1:D10])
If Not IsEmpty(iCell) Then
If (Month(iCell) <> Month(Now())) Or _
(Year(iCell) <> Year(Now())) Then
MsgBox "Э нет! Месяц-год не совпадают с текущими!"
iCell.ClearContents 'запретить, т.е. удалить, выбрать только одно
End If
End If
Next
Application.EnableEvents = True
End If
End Sub

SERGE_BLIZNUK ,

спасибо! То, что надо.

а можно ещё так: анализ первых 2-ух или 4-ёх букв в ячейке. Т.е. как только в ячейке появляются данные, где первые 2 буквы "ББ" то, в соседней ячеке появлется значение "КУ-КУ"?

Собственно задачка такова: есть несколько колонок с иногда, в произвольном порядке повторяющимися в них текстовыми данными. Нужно подсчитать % каждого уникального значения от общего количества значений внутри каждой колонки.

Итак, нужен счётчик - как объект состоящий из двух полей - текста (для опознания) и целого (для собственно счёта), и это для каждой колонки

Например такая колонка:

аа
аа
бб
фф
фф
бб
аа

Цикл должен перебрать их все по порядку. Сначала получаем "аа", смотрим, если и у нас счётчик для этого значения? Цикллом наверное сделать? .Или как то сделать тоже объект, которому скармливать значения одно за другим?
Итак, ищем счётчик с "аа", такого нет. Создаем счётчик с данными "аа" и 1.
След. значение - "аа" - такой счётчик найден, значит увеличиваем его на 1 - теперь он у нас выглядит так "аа" 2.
След значение - "бб", такого счётчика у нас нет, создаём "бб" 1 и тд
В итоге получается список объектов-счётчиков

"аа" 3
"бб" 2
"фф" 2

Общая сумма элементов - 7

значит

"аа" - 3/7 = 0,42857142857142857142857142857143 ~ 42,86%
"бб" - 2/7 = 0,28571428571428571428571428571429 ~ 28,57%
"фф" - 3/7 = 0,28571428571428571428571428571429 ~ 28,57%

Логика ясна, более-менее, а вот как это записать в виде кода?

nopoxz
ниже текст в порядке бреда..
есть такая штука, как "парадигма". Так вот, то, что вписывается в эту самую парадигму, можно сделать. А вот то, что не вписывается - либо вообще сделать нельзя, либо сделать очень сложно и через известное место ;-(
Так вот, одной из таких парадигм в Excel является то, что значение вносится, проверяется, обрабатывается после выхода из неё!! И событие WorkSheet_Change возникает ПОСЛЕ выхода...
поэтому, либо откажитесь от Вашей идеи, либо копайте в сторону глобальных хуков o_O :-(((
кстати, если использовать форму, то там есть Form_KeyDown ...
А ещё подобное поведение легко запрограммировать в форме на любом ЯП высокого уровня (например, на Delphi)...

RE (SERGE_BLIZNUK)
Ой, спасибо за помощь, я вчера просто вопрос разместил, и своего поста не увидел, и решил продублировать с уточнениями. После публикации нового поста - увидел старый. ~

hariamatyhari
понятно. удачи.

SERGE_BLIZNUK

вас понял

А не могли бы вы показать на примере код для оценки двух первых букв в ячейке?


Хочу сделать так: если в ячейке данные начинаются с "ББ" и во второй ячеке (таже строка, но на 4 ячейки левее) введено значение "Привет", то в третьей ячейке (таже строка, но на 10 правее) вставлялось слово "Ура"

nopoxz

Цитата:

если в ячейке данные начинаются с "ББ" и во второй ячеке (таже строка, но на 4 ячейки левее) введено значение "Привет", то в третьей ячейке (таже строка, но на 10 правее) вставлялось слово "Ура"

вот код [more]
Код:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iCell As Range
' анализируем только изменения в столбцах A затем E
If Not Intersect(Target, [A:A]) Is Nothing Then
Application.EnableEvents = False
For Each iCell In Intersect(Target, [A:A])
If (Not IsEmpty(iCell)) And _
(TypeName(iCell.Value) = "String") And _
(Not IsEmpty(iCell.Offset(, 4))) And _
(TypeName(iCell.Offset(, 4).Value) = "String") _
And (iCell = "Привет") And (Left(iCell.Offset(, 4).Value, 2) = "ББ") Then
iCell.Offset(, 14).Value = "УРА! ЗАРАБОТАЛО!"
Else
' тут можно стирать УРА, если его нужно убирать...
iCell.Offset(, 14).ClearContents
End If
Next
Application.EnableEvents = True
End If

If Not Intersect(Target, [E:E]) Is Nothing Then
Application.EnableEvents = False
For Each iCell In Intersect(Target, [E:E])
If (Not IsEmpty(iCell)) And _
(TypeName(iCell.Value) = "String") And _
(Not IsEmpty(iCell.Offset(, -4))) And _
(TypeName(iCell.Offset(, -4).Value) = "String") _
And (iCell.Offset(, -4) = "Привет") And (Left(iCell, 2) = "ББ") Then
iCell.Offset(, 10) = "УРА! ЗАРАБОТАЛО!"
Else
' тут можно стирать УРА, если его нужно убирать...
iCell.Offset(, 10).ClearContents
End If
Next
Application.EnableEvents = True
End If

End Sub

Вообще в шоке, как такое может быть:
вызываю процедуру для получения всех каталогов в текущем каталоге, текущий каталог \\gukdc3\Доступ\Книга задач, когда получаем fs.GetFolder(myPath) возвращает
\\gukdc3\[]?ABC\Книга задач на всех сетевых компах. На моем компе, на котором я и писал этот код все нормально. что это может быть? Причем папку получаю нормально, только путь у нее корявый. Заранее благодарен за помощь
Sub GetFileListFSO(myPath As String, i As Long, DirArray)

Dim fold1, fold2, iFile, File
Dim Cdir As String
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")

Application.StatusBar = myPath

Set fold1 = fs.GetFolder(myPath)
'MsgBox (fold1)
For Each fold2 In fold1.SubFolders
'Cdir = Mid(fold2.Name, 1, 5)

If Cdir <> "Архив" Then
i = i + 1
ReDim Preserve DirArray(i)
DirArray(i) = fold2.Path & "\"
'MsgBox (DirArray(i))
GetFileListFSO fold2.Path & "\", i, DirArray
End If
Next

Application.StatusBar = False

End Sub

Подскажите есть ли функция которая не различает заглавные и строчные буквы ,например мне нужно найти слово DADAnet а ввела dadaNET?
жду ответа!

Здравствуйте, может с помощью хитроумного скрипта можно помочь в решении моей маленькой проблемы.
Суть вот в чём:

Есть столбец с данными, скажем для примера 5 строчек.(А1 до А5)
Нужна формула для специального среднего результата- поясню требования: минимальное и максимальное число из столбца не учитывается в подсчёте обычного среднего арифметического .
В ручную это делать слишком долго и муторно, сотни и сотни столбцов и нет им конца.
Пришли в данный момент к формуле:
=(SUM(A1:A5)-MIN(A1:A5)-MAX(A1:A5))/(COUNT(A1:A5)-2)

При отнимании числа 2- ты точно знаешь что есть один максимум ,и один минимум. А это не всегда так.
For exp.:
1
25
1
220
100
Я что хочу сказать, просто не все комбинации предложенная формула считает правильно.

ValentinaK
Надо приводить к одному case:
If Ucase(что ищем) = Ucase(с чем сравниваем) Then
или использовать функцию Like

Здравствуйте. Я уже как-то обращался в данную ветку по поводу надстройки KaotiXLdemo.xla. Тогда речь шла о том, чтобы сделать надстройку работоспособной. Благодаря уважаемому SERGE_BLIZNUK макрос заработал, правда с ограничениями (поскольку на сайте разработчика была выложена демонстрационная версия). Ограничения эти касаются объема обрабатываемого массива данных - Demo version only allow you to enter 100 rows of closing prices (т.е. максимум 100 строк). Подскажите, пожалуйста, насколько реально снять это ограничение??? Может ли кто-нибудь из здесь присутствующих помочь с данной проблемой? Исправленная SERGE_BLIZNUK версия выложена здесь. Оригинал макроса находится здесь.
Заранее огромное спасибо!!!

dneprcomp
А можно поподробнее, плиз!
у меня был код :
strItemCode = UCase(strItemCode)
но как понимаешь он не подходит!
жду!!!