» Excel VBA

К слову о надстройках.

Да простят меня модераторы, но в варезнике появился кряк для DigDB. Кому интересно. Сам пока не пробовал, правда.

Передача данных из Excel в MS-SQL или Access

Проблема в том что есть калкуляция цены в Excel и надо резултат передать в базу данных.
В Excel-таблице есть ячейка("ArtNr") с номером товара,
и цена в ячейке ("preis")

Нужно по нажатию на кнопку таблицыExcel, в базе днных "SQL" в таблице "dtbLager" найти товар с номером соответствующем номеру в таблице-Еxcel и прописать в бд"SQL" в таблице "dtbLager"
в столбце"VKPreis" цену из Excel-таблицы ячейки ("preis") .

!!! Помогите пожалуста найти решение !!!!!!

Troitsky
А в ячейке A7 оставалось "Вася мальчик"?
И так нужно для всех ячеек документа?
Слово известно или такое проворачивается именно со вторым словом в каждой ячейке?

Больше конкретики.

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

evruka

Код: Sub rlock()
Dim ws As Worksheet
Dim i As Integer
Set ws = Application.ActiveSheet
'Отключение защиты
ws.Unprotect
'Удаление всех диапазонов, защищенных в данный момент
For i = 1 To ws.Protection.AllowEditRanges.Count
ws.Protection.AllowEditRanges(i).Delete
Next
'Создание защиненного диапазона
ws.Protection.AllowEditRanges.Add Title:="Заголовок", Range:=Range("A1:A4"), Password:="hide"
'Защита листа (иначе защита диапазона не будет включена)
ws.Protect
End Sub

Как сделать так чтобы список в столбце A
Допустим A1:A20
превратился в 20 листов,где имена это значения в ячейках.

ZORRO2005
Код:
Sub CreateSheets()
Dim Cell As Range
Dim wsNewSheet As Worksheet

On Error Resume Next
Application.ScreenUpdating = False
For Each Cell In [A:A].SpecialCells(xlCellTypeConstants)
Set wsNewSheet = Worksheets.Add
wsNewSheet.Name = Cell
If Err <> 0 Then _
wsNewSheet.Name = InputBox( _
"Лист с таким именем уже существует. Введите другое имя", _
"Ошибка")
Next Cell
Application.ScreenUpdating = True
End Sub

ZORRO2005

Цитата:

Как сделать так чтобы список в столбце A
Допустим A1:A20
превратился в 20 листов,где имена это значения в ячейках.

Sub Макрос1()
Dim LastRow As Long, r As Long
'Определяем последнюю строчку
LastRow = Range("A65536").End(xlUp).Row
For r = 4 To LastRow 'имеется ввиду, что три листа есть
Sheets.Add
Next r
End Sub

The okk
Спасибо.
А можно сделать так чтобы листы добавлялись в конец а не в начало
и чтобы они шли по порядку,а не в обратном порядке.
Т.е.
Если есть Лист1
В A1:A4 (Январь,Февраль,Март,Апрель)
То чтобы листы были в таком порядке:
Лист1,Январь,Февраль,Март,Апрель
а сейчас
Апрель,Март,Февраль,Январь,Лист1
Заранее спасибо

Здравствуйте.
Подскажите начинающему. У меня данные в таблицу поступают из интернета в реал-тайме. Мне нужно чтобы если значение в какой-то ячейке становилось, допустим, меньше ноля, то это бы выделялось красным цветом шрифта.
Заранее благодарен. Собатие Private Sub Worksheet_Change(ByVal Target As Range) не работает, а только при вводе значения вручную.

ZORRO2005

Цитата:

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

Код: Sub CreateOrderofSheets()
Dim Cell As Range
Dim wsNewSheet As Worksheet

On Error Resume Next
Application.ScreenUpdating = False
For Each Cell In [A:A].SpecialCells(xlCellTypeConstants)
With Worksheets
Set wsNewSheet = .Add(After:=.item(.Count))
End With
wsNewSheet.Name = Cell
If Err <> 0 Then _
wsNewSheet.Name = InputBox( _
"Лист с таким именем уже существует. Введите другое имя", _
"Ошибка")
Next Cell
Application.ScreenUpdating = True
End Sub

Большое спасибо. Оказалось гораздо проще чем я думал

aks_sv

Цитата:

Sub Макрос1()
Dim LastRow As Long, r As Long
'Определяем последнюю строчку
LastRow = Range("A65536").End(xlUp).Row
For r = 4 To LastRow 'имеется ввиду, что три листа есть
Sheets.Add
Next r
End Sub

Надеюсь, мои комментарии помогут тебе лучше понять VBA... хотя бы немного:

Код: Dim LastRow As Long, r As Long

The okk

Цитата:

Код: LastRow = Range("A65536").End(xlUp).Row

По сути тоже правильно. Можно было бы и Cells вместо Range поставить, но не существенно. Последняя строка определена грамотно.

Troitsky
У меня 2007 нету. И, судя по отзывам, которые я читал, мне он совершенно не нужен.

The okk
Цитата:

LastRow = Range("A65536").End(xlUp).Row

Troitsky
Цитата:

Rows.End(xlDown).Row

Вроде я не новичок уже. Но тем не менее. ;-))
Господа, разъясните, пожалуйста: я использую для определения последней используемой строки код вида
Код: LastRow= ThisWorkbook.ActiveSheet.UsedRange.Row + ThisWorkbook.ActiveSheet.UsedRange.Row.Count

SERGE_BLIZNUK

Цитата:

Есть ли отличия в использовании ваших End(xlUp) / End(xlDown) и моим вариантом? И если да - то какие?..

Вот если на листе засветить последние строчки и очистить их нажав кнопку Delete, то разными методами получишь разные значения LastRow. Поэтому я лично этим значениям никогда не верю, а для подстраховки ещё и почитаю снизу вверх до первой непустой строки.

Цитата:

Function Last_Row(ws As WorkSheet, colToCheck As String) As Long
Dim rw As Long, tmpLastRow As Long

'---------------------------------------------------------------------------------
' Сначала любым способом находим предполагаемую последнюю строку
'---------------------------------------------------------------------------------

'-----------------------------------------------------------------------
'Допустим. так
'-----------------------------------------------------------------------
ws.Activate
tmpLastRow = ActiveWindow.ActiveCell.SpecialCells(xlCellTypeLastCell).Row

'-----------------------------------------------------------------------
'или же так (лично мне этот больше всех нравится - самый точный)
'-----------------------------------------------------------------------
tmpLastRow = ws.Cells.Find(What:="*", After:=[A1],SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

'-----------------------------------------------------------------------
'или же так
'-----------------------------------------------------------------------
tmpLastRow = ws.Range(colToCheck & 1).End(xlDown).Row

'-----------------------------------------------------------------------
'или же так
'-----------------------------------------------------------------------
tmpLastRow = ws.Rows.End(xlDown).Row

'-----------------------------------------------------------------------
'-----------------------------------------------------------------------
'Теперь для подстраховки читаем вверх до первого непустого
'значения в проверяемой колонке
'-----------------------------------------------------------------------
For rw = tmpLastRow To 1 Step -1
If Not IsEmpty(ws.Range(colToCheck & rw).Value) Then
Last_Row = rw
Exit Function
End If
Next rw
'-----------------------------------------------------------------------
'Опаньки! А лист-то пустой!
'-----------------------------------------------------------------------
Last_Row = 0
End Function

SERGE_BLIZNUK
Это смотря что определять.
Код: Columns(1).End(xlDown)

салюты многоуважаемые!

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

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

vzbzdnov
The okk
Большое спасибо за разъяснения. (думаю, что они не только мне будут полезны. Кстати, может кто-то в шапку добавит (если это целесообразно, конечно)?)

vzbzdnov
Совершенно верно. Помимо свойств есть еще и методы.
Код: ActiveWindow.ActiveCell.SpecialCells(xlCellTypeLastCell)

SERGE_BLIZNUK

Цитата:

Код: LastRow= ThisWorkbook.ActiveSheet.UsedRange.Row + ThisWorkbook.ActiveSheet.UsedRange.Row.Count

Есть ли отличия в использовании ваших End(xlUp) / End(xlDown) и моим вариантом? И если да - то какие?..

Troitsky
Я просто скопировал то, что у него было - только и всего На самом деле, если мне нужно количество строк в листе, использую ThisWorkbook.ActiveSheet.UsedRange.Rows.Count. Но мне в последнее время это не нужно.
Спасибо, что сказал. Сейчас исправлю то сообщение.

The okk
Цитата:

Я просто скопировал то, что у него было - только и всего

по поводу rows.count - тут я ошибся (чисто описка)
По поводу ошибки на единицу - полностью согласен - надо вычитать...
Цитата:

если мне нужно количество строк в листе, использую ThisWorkbook.ActiveSheet.UsedRange.Rows.Count

только нужно учитывать - что это именно количество ИСПОЛЬЗОВАННЫХ строк - т.е. если в середине листа заполнить одну ячейку - то count резонно вернёт 1 (т.е. я не представляю, зачем может понадобится usedRange.Rows.Count без usedRange.Row...

Впрочем, господа vzbzdnov, The okk, Troitsky - ещё раз большое спасибо. Обсуждение лично для меня было очень полезным.

SERGE_BLIZNUK

Цитата:

только нужно учитывать - что это именно количество ИСПОЛЬЗОВАННЫХ строк - т.е. если в середине листа заполнить одну ячейку - то count резонно вернёт 1 (т.е. я не представляю, зачем может понадобится usedRange.Rows.Count без usedRange.Row...

Такой вариант может быть только если первые строки не используются. Если использована первая и, например, сотая строка, то UsedRange.Rows.Count = 100. В случае же, если первые строки не используются (интересно почему?!), пожалуй, стоит использовать
Код: ActiveWindow.ActiveCell.SpecialCells(xlCellTypeLastCell)

The okk
Спасибо большое

The okk

Цитата:

если мне нужно количество строк в листе, использую ThisWorkbook.ActiveSheet.UsedRange.Rows.Count.

Опять же - если перед этим очистил последние строчки, то они всё равно покажутся в этом счётчике, что не есть гуд. Поэтому я ещё и читаю снизу вверх

vzbzdnov

Цитата:

Опять же - если перед этим очистил последние строчки, то они всё равно покажутся в этом счётчике

Каким образом ты их "очистил"? Удалил значение, а комментарии и/или форматирование оставил? Разумеется, в этом случае они будут учитываться.
Если же ты использовал ячейки, а потом удалил их (полностью), они в UsedRange не попадут.
Цикл тут совершенно не нужен. В крайнем случае можно найти последнюю ячейку методом Find.

The okk

Цитата:

Каким образом ты их "очистил"? Удалил значение, а комментарии и/или форматирование оставил? Разумеется, в этом случае они будут учитываться.
Если же ты использовал ячейки, а потом удалил их (полностью), они в UsedRange не попадут.

Лично мне приходится писать макросы для юзверей. А рассчитывать на умного юзера это утопия. И как он там что почистит-удалит одному Гейтцу ведомо. Тем более, что когда он придёт с предъявой на баг, то повторить, что он там сделал, не сможет в 100 из 100 случаев.
Поэтому макрос должен быть непробиваемым на 200%. А лишний цикл (в большинстве случаев это будет всего один виток) не повредит.

Тут у меня более интересный вопрос возник - как переименовать Class? (Для тех, кто не в курсе, дальше можно не читать. ) Чичас я его выгружаю, удаляю, редактирую выгруженное и гружу взад. Очень уж много телодвижений получается. А, может, можно как-нить просто переименовать? Не нашёл такой фичи.

Можно я тоже вставлю свои 5 копеек?
The okk
Цитата:

Код: Columns(1).End(xlDown)

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

The okk

Цитата:

А поконкретней?

В каждом листе больше 1000 строк, а в форме листбокс дольго думает.

Я не понял, почему в каждом листе отображается последний лист, а предыдущие не отображается?????

Код:
Private Sub TextBox1_Change()
Dim rng As Range
Dim r As Range
Dim strFilt As String
Dim strFiltLen As Integer
Dim arrFilt As Variant 'динамический массив
Dim ColCnt As Integer
Dim i As Integer, c As Integer
Dim ls As Worksheet

For Each ls In Worksheets 'в каждом листе
ColCnt = ls.UsedRange.Columns.Count 'проходим по всем столбцам
Set rng = ls.UsedRange.Rows 'и по всем строкам

strFilt = TextBox1.Text
strFiltLen = Len(strFilt)
i = 0
ReDim arrFilt(ColCnt - 1, i)
For Each r In rng.Rows
If strFilt = Left(r.Cells(1).Text, strFiltLen) Then
ReDim Preserve arrFilt(ColCnt - 1, i)
For c = 1 To ColCnt
arrFilt(c - 1, i) = r.Cells(1, c).Value
Next
i = i + 1
End If
Next

Next
With ListBox1
.Column() = arrFilt
.ColumnCount = ColCnt
End With
End Sub

Private Sub UserForm_Initialize()
TextBox1_Change
End Sub