» Excel VBA (часть 2)

разные Excel английский или русский работает по разному, в вычисляемое поле добавляется приставка "Сумма по полю " ну а в английском на английском, и потом в макросе не могу к нему обратиться?!!?! пробовал через номер объекта унифицировать, но обратиться не получается
Сначала номер объекта вычислил:

Код: With Worksheets("TEMP").PivotTables(1)
For i = 1 To .PivotFields.Count
MsgBox .PivotFields(i).Name & " #: " & i
Next
End With

nick7inc



Цитата:

если я делаю одинаковую операцию для N листов, например эту:

Мне думается, что в этом случае надо вставить операцию над листами в отдельную процедуру, которая в качестве параметров принимает координаты в какой-нибудь форме.

К сожалению я так и не понял как сделать отдельную процедуру-(
У меня есть скрипт для одного листа "SI", как мне применить его для еще 15-ти листов, которые я пропишу (это касается не всех листов книги)?
Sheets("Period").Select
Columns("K:AC").Select
Selection.Copy
Sheets("SI").Select
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Application.CutCopyMode = False
Dim r1 As Range, r2 As Range, r3 As Range, ws As Worksheet
Set ws = Workbooks("11.xls").Sheets("SI")
Set r1 = ws.Range(ws.Columns(21), ws.Columns(37))
Set r2 = ws.Range(ws.Columns(79), ws.Columns(95))
Set r3 = ws.Range(ws.Columns(105), ws.Columns(121))
r1.Copy r2
r1.Copy r3
Application.CutCopyMode = False
Set ws = Workbooks("11.xls").Sheets("SI")
Set r1 = ws.Range(ws.Columns(21), ws.Columns(23))
Set r2 = ws.Columns(8)
r1.Copy
r2.Insert Shift:=xlToRight
Application.CutCopyMode = False



Добавлено:

то же самое (запустить процедуру на конкретных листах а не во всей книге) я хотел бы сделать и тут:

Public Mes As Integer
Sub Start()
Dim i As Long, j As Integer, Stolb As Long
Const Sdvig1 = 55
Const Sdvig2 = 81
Stolb = Mes + 27
Application.ScreenUpdating = False
For j = 2 To ActiveWorkbook.Sheets.Count
Sheets(j).Select
For i = 1 To ActiveSheet.Cells(65536, 28).End(xlUp).Row
If IsNumeric(Cells(i, 28)) And Cells(i, 28) <> "" Then
Cells(i, 2) = Cells(i, Stolb)
Cells(i, 3) = Cells(i, Stolb + Sdvig1)
Cells(i, 5) = Cells(i, Stolb + Sdvig2)
Cells(i, 12) = Application.Sum(Range(Cells(i, 28), Cells(i, Stolb)))
Cells(i, 13) = Application.Sum(Range(Cells(i, 28 + Sdvig1), Cells(i, Stolb + Sdvig1)))
Cells(i, 15) = Application.Sum(Range(Cells(i, 28 + Sdvig2), Cells(i, Stolb + Sdvig2)))
End If
Next i
Next j
Sheets(1).Select
End Sub

буду очень признателен за помощь.

ol7ca

Цитата:

запустить процедуру на конкретных листах а не во всей книге

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

SAS888


Цитата:

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

Как это можно сделать? имена листов известны.
Кстати, второй скрипт Вы помогли мне создать - за него еще раз отдельное спасибо, очень полезен!

ol7ca

Цитата:

Sheets("Period").Select
Columns("K:AC").Select
Selection.Copy
Sheets("SI").Select
Columns("B:B").Select

Операция Select потенциально медленная и лучше от неё избавиться, но для начала можно оставить, хотя изображение будет мерцать.
Цитата:

К сожалению я так и не понял как сделать отдельную процедуру-(

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


Добавлено:
SAS888

Цитата:

можно, например создать массив

или сделать какую-нибудь метку на самом листе, чтобы от других отличить. А по поводу массива, то можно завести специальный лист, назвать его "Настройки", и там перечислить все имена тех листов, с которыми надо что-то проделать. Сам так иногда делаю.

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

Dmi_Tro
Набросок

Код:
Dim fso As Object, pFile As Object, pFolder As Object, nextFolder As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set pFolder = fso.GetFolder("d:\path\basefoldername")
For Each nextFolder In pFolder.SubFolders
For Each pFile In nextFolder.Files
If LCase$(fso.GetExtentionName(pFile.Name)) = "xls" Then
WorkBooks.Open pFile.Path
End If
Next pFile
Next nextFolder

nick7inc

Цитата:

Операция Select потенциально медленная и лучше от неё избавиться, но для начала можно оставить, хотя изображение будет мерцать.

чем ее можно заменить?

я только начал работать с VBA поэтому имею больше вопросов чем ответов.
я знаю, что такое процедура и функция и как их создавать. но как их красиво сочетать и как передавать параметры не знаю. поэтому и задаю эти вопросы.

ol7ca

Цитата:

Цитата: Операция Select потенциально медленная и лучше от неё избавиться, но для начала можно оставить, хотя изображение будет мерцать.

чем ее можно заменить?

ol7ca

Цитата:

Как это можно сделать? имена листов известны.

Например, так:


Код: Dim ws As Object, i As Integer, a
a = Array("Лист1", "Лист3", "Лист8") 'листы, которые нужно обработать
For i = 0 To UBound(a)
Set ws = Sheets(a(i))
With ws
.Range("A1") = "Yes" ' здесь Ваш исполняемый код
End With
Next

Здравствуите, если правильно понял на соседнеи ветке мою задачу можно решить только через VBA, и так, необходимо, чтобы в ячеике в1 отображалось последнее число которое>0 из области а1-а30, в этои области может быть и пустые ячеики,

пример 1:
a1=1
a2=8
a3=6, результат: в1=6
остальные ячеики до а30 пустые

пример 2:
a1=1
a2= путая
a3=6
a4=4, результат: в1=4
остальные ячеики до а30 пустые

пример 3:
a1=0
a2=пустая
a3=0
a4=4
a5=8
а6=21, результат: в1=21
остальные ячеики до а30 пустые

virginijus

Цитата:

необходимо, чтобы в ячеике в1 отображалось последнее число которое>0 из области а1-а30, в этои области может быть и пустые ячеики

[more=код]
Код: Dim in_r as Range, out_r as Range, i as range, d as Double
set in_r=Workbooks("MyBook.xls").Sheets("MySheet").range("A1:A30")
set out_r=Workbooks("MyBook.xls").Sheets("MySheet").cells(1,"B")
' если надо искать на текущем листе текущей книги, то так:
'set in_r=range("A1:A30")
'set out_r=cells(1,"B")

for each i in in_r
d=i.cells(i,1).value
if d>0 then out_r.value=d
next i

SAS888

Выдает ошибку. Наверное я что-то на так сделал.
Sub Start()
Dim ws As Object, k As Integer, a
a = Array("BU", "SI", "SI - I")
For k = 0 To UBound(a)
Set ws = Sheets(a(k))
With ws

Dim i As Long, j As Integer, Stolb As Long
Const Sdvig1 = 55
Const Sdvig2 = 81
Stolb = Mes + 27
Application.ScreenUpdating = False
For j = 2 To ActiveWorkbook.Sheets.Count
Sheets(j).Select
For i = 1 To ActiveSheet.Cells(65536, 28).End(xlUp).Row
If IsNumeric(Cells(i, 28)) And Cells(i, 28) <> "" Then ' тут err 13 type mismatch
Cells(i, 2) = Cells(i, Stolb)
Cells(i, 3) = Cells(i, Stolb + Sdvig1)
Cells(i, 5) = Cells(i, Stolb + Sdvig2)
Cells(i, 12) = Application.Sum(Range(Cells(i, 28), Cells(i, Stolb)))
Cells(i, 13) = Application.Sum(Range(Cells(i, 28 + Sdvig1), Cells(i, Stolb + Sdvig1)))
Cells(i, 15) = Application.Sum(Range(Cells(i, 28 + Sdvig2), Cells(i, Stolb + Sdvig2)))
End If
Next i
Next j
Sheets(1).Select
End With
Next
End Sub


Добавлено:
nick7inc


Цитата:

Операция Select потенциально медленная и лучше от неё избавиться,

спасибо. очень полезная информация. попробую применить.

ol7ca

Цитата:

Выдает ошибку. Наверное я что-то на так сделал.

Похоже на то. У меня с пустыми листами работает, наверное ошибка из-за каких-то ваших данных. Весь файл в студию!

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

nick7inc

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

HORAS1
[more=держи для примера]

Код:
'допущения: анализ с первой строки по последюю строку области данных текущего листа;
'числа в колонках A, B, C
Public Sub RemoveNegativeRows()
Dim vLastRow As Long, i As Long, vCount As Long
vLastRow = ActiveSheet.UsedRange.Rows.Count
i = 1&
Do Until i > vLastRow
vCount = 0&
If IsNumeric(Cells(i, 1&).Value) Then
If Cells(i, 1&).Value > 0# Then vCount = vCount + 1&
End If
If IsNumeric(Cells(i, 2&).Value) Then
If Cells(i, 2&).Value > 0# Then vCount = vCount + 1&
End If
If IsNumeric(Cells(i, 3&).Value) Then
If Cells(i, 3&).Value > 0# Then vCount = vCount + 1&
End If
If vCount < 2& Then
vLastRow = vLastRow - 1&
Cells(i, 1&).EntireRow.Delete Shift:=XlDeleteShiftDirection.xlShiftUp
Else
i = i + 1&
End If
Loop
End Sub

ol7ca
Внутри внешнего цикла (по выбранным листам), Вы делаете еще цикл по листам всей рабочей книги. Код должен быть примерно таким:

Код: Sub Start()

Dim ws As Object, k As Integer, a
Dim i As Long, j As Integer, Stolb As Long
Const Sdvig1 = 55
Const Sdvig2 = 81
Stolb = Mes + 27

Application.ScreenUpdating = False
a = Array("BU", "SI", "SI - I")
For k = 0 To UBound(a)
Set ws = Sheets(a(k))
With ws
For i = 1 To .Cells(65536, 28).End(xlUp).Row
If IsNumeric(.Cells(i, 28)) And .Cells(i, 28) <> "" Then
.Cells(i, 2) = .Cells(i, Stolb)
.Cells(i, 3) = .Cells(i, Stolb + Sdvig1)
.Cells(i, 5) = .Cells(i, Stolb + Sdvig2)
.Cells(i, 12) = Application.Sum(Range(.Cells(i, 28), .Cells(i, Stolb)))
.Cells(i, 13) = Application.Sum(Range(.Cells(i, 28 + Sdvig1), .Cells(i, Stolb + Sdvig1)))
.Cells(i, 15) = Application.Sum(Range(.Cells(i, 28 + Sdvig2), .Cells(i, Stolb + Sdvig2)))
End If
Next i
End With
Next
Sheets(1).Select

End Sub

Помогите, пожалуйста. Из 1С-ки достаю числа в формате NNN,NNN.NN
Чтобы пациенты были операбельны, требуется, естественно, привести их к виду NNNNNN,NN

Записываю макрорекордером замену, правлю, получаю макрос такого вида:

Код:
Selection.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
Selection.NumberFormat = "0.00"

ru4room

Цитата:

после выполнения макроса ДРОБНЫЕ числа форматируются как текст

[more=код]Открываете редактор Visual basic, правой клавишей по "эта книга", Insert->Module и вставляете этот макрос. Когда надо исправить числа выделяете нужный диапазон и выполняете макрос fix.

Код: Sub fix()
Dim r As Range, i As Variant
If TypeName(Selection) <> "Range" Then MsgBox "Select range!", vbExclamation, "Error": Exit Sub
Set r = Selection
For Each i In r
If Not (IsEmpty(i)) Then
' Если разделитель целой и дробной части всегда точка
i.Value = Val(Replace(i.Text, ",", ""))
' Если разделитель целой и дробной части определяется настройками системы
' i.Value = CDbl(Replace(i.Text, ",", ""))

End If
Next i

End Sub

ru4room
Все существенно проще:
Во второй части Вашей замены измените Replacement:="," на Replacement:=Application.DecimalSeparator и будет счастье.

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

Dmi_Tro
Что значит
Цитата:

эксель открывает другие файлы, извлекает из них данные и заносит в таблицу

? Если работает макрос, то пусть он делает то, что Вам нужно (и не более того).

Dmi_Tro Ставить метку в тех файлах, откуда извлекаются данные, - признак что данные уже извлечены ... Требуется конечно более детальное описание - но как я себе представляю, в файлах-источниках есть строки - напротив "извлеченной" строки нужно ставить метку и соовтетсвтенно при следующем извлечении, такие строки пропускать. Это в случае, если извлеченные строки не меняются в исходных данных, а просто идет добавление. Если же могут меняться и ранее извлеченные строки - то дело сложнее - но в принципе тоже можно извратиться ... Хотя в таком случае уже надо задумываться о базах данных.

SAS888

спасибо, все корректно заработало


Цитата:

И еще, я не помню, откуда берется переменная (или константа) "Mes"? Это "Public"?

да

Нужен совет, мой файл работает очень медленно. Что можно сделать для того, чтобы ускорить работу?
Выложить весь файл нет возможности (могу выложить кусок). В исходном состоянии он весит 10Мб, состоит из 100 листов. С помощью скрипта
(первый по счету в моем постинге http://forum.ru-board.com/topic.cgi?forum=33&topic=8273&start=1560#3)
я добавляю аналитические таблицы в 60 листов, эти таблицы имеют такие же ссылки как и исходные, т.е. увеличивается количество ссылок. Далее с помощью скрипта
(в постинге SAS888 for ol7ca http://forum.ru-board.com/topic.cgi?forum=33&topic=8273&start=1560#19)
я делаю анализ данных и пересчет занимает 10-15 мин. И файл начинает весить 22Мб.
Буду признателен за помощь.

удалил сообщение т.к. разобрался сам

nick7inc, ошибку выдаёт

SAS888, спасибо, но не помогло

upd. в итоге помогло простое trim() о_О Фантастика!

Как отменить удаление текста юзером из TextBoxa?
Есть у TextBox событие KeyDown и MouseDown. Можно конечно сохранить там удаляемый символ, а потом в KeyUp вставить его снова. Может есть лучшее решение?

nick7inc Спасибо за код

Цитата:

необходимо, чтобы в ячеике в1 отображалось последнее число которое>0 из области а1-а30, в этои области может быть и пустые ячеики

Dim in_r as Range, out_r as Range, i as range, d as Double
' set in_r=Workbooks("MyBook.xls").Sheets("MySheet").range("A1:A30")
' set out_r=Workbooks("MyBook.xls").Sheets("MySheet").cells(1,"B")
' если надо искать на текущем листе текущей книги, то так:

set in_r=range("A1:A30")
set out_r=cells(1,"B")

for each i in in_r
d=i.cells(i,1).value
if d>0 then out_r.value=d
next i

Но он что-то не работает, пишет:

Compile error:
Invalid outside procedure

Как быть не поиму??