» Excel VBA

AndVGri

Цитата:

Почему старт с 24 строки?

Потому, что с 24 строки начинается сама таблица с данными. Ребят, помогите решить эту задачу, т.к. это нужно для формирования прайса в Акцессе, но сначала нужно решить в экселе. Нужно, чтобы по каждому наименованию, которое находится в столбце С добавилась соответсвующая категория в любой свободный столбец (например, L), которая находится в столбце А, только есть некоторые ньюнансы, например, наименование - Сист.блок..., а категория - Компьютеры Flextron, наименование - кулер, а категория - Охлажадющие устройства. Поэтому я и пошла более простым? способом - извлечь из наименования первое слово, добавить в свободный столбец и так по каждому наименованию, и таким образом сформировать свои категории, потому, что не знаю как можно сравнить Сист.блок с Компьютером. Только вот код, конечно же не работет. Я не очень сильна в программировании, я только учусь. Ну хоть помогите составить код. в книгах ничего приблизительно похожего не нашла.
    
    

keha

Цитата:

Можно как-нибудь с помощью макросов создать пустой (новый) текстовый файл и записать в него с разделителями выборочные столбцы? <...> чтобы в текстовый файл попали данные из столбцов A, D и E, разделенные точкой с запятой.)

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

Код: Dim F As Integer
Dim r As Range
Dim strTemp As String

F = FreeFile ' Определяем свободный номер файла
Open "C:\temp.csv" For Output As #F
For Each r In ActiveSheet.UsedRange.Rows
strTemp = ""
strTemp = CStr(Cells(r.Row, 1).Value) & ";" & _
CStr(Cells(r.Row, 4).Value) & ";" & _
CStr(Cells(r.Row, 5).Value)
Print #F, strTemp
Next r
Close #F

Panteran3785

Цитата:

Потому, что с 24 строки начинается сама таблица с данными

Сударыня, вы коварны. Прайс fcenter я скачал, собственно таблица с данными начинается с 144 строки, да и расположение колонок данных несколько иное, чем вы приводите. Код решающий вашу проблему в пределах того, что я понял из ваших пояснений
[more]
'Макрос расчитан на работу только с price fcenter
'создаёт колонку группы товара и колонку категории этой группы
'далее можно автофильтром выбрать нужное
'или изменить макрос на создание 3 листов: данных с индексами справочников,
'справочника групп, справочника категорий
'для работы макроса нужно в Tools/References... подключить Microsoft Scripting Runtime

Private Const GroupCol As Long = 9& 'колонка вывода названия группы
Private Const CategoryCol As Long = 10& 'колонка вывода названия категории
Private Const GroupSign As String = "наверх" 'признак начала группы
Private Const CategoryColor As Long = -4105& 'цвет шрифта категорий
Private Categories As New Scripting.Dictionary

'Создать справочник категорий групп товаров
Private Sub CreateCategory()
Dim vFirst As Long, vLast As Long
Dim i As Long, sCategory As String
'Найти диапазон описаний групп и их категорий
vFirst = Cells(8&, 1&).CurrentRegion.Row
vLast = Cells(8&, 1&).CurrentRegion.Rows.Count + vFirst - 1&
'по области данных
For i = vFirst To vLast
'если цвет шрифта - категории, то получить её название
If Cells(i, 1&).Font.ColorIndex = CategoryColor Then
sCategory = CStr(Cells(i, 1&).Value)
Else 'иначе, добавить группу, как ключ категории
Categories.Add CStr(Cells(i, 1&).Value), sCategory
End If
Next i
End Sub

Public Sub FillGroupColumn()
Dim i As Long, sGroup As String
Dim vLastRow As Long, sCategory As String

Call CreateCategory 'создать спавочник категорий групп
vLastRow = ActiveSheet.UsedRange.Rows.Count - 3& '3 - смещение на подпись
'поиск названия первой группы
i = 1&
Do Until InStr(LCase$(CStr(Cells(i, 1&).Value)), GroupSign) <> 0&
i = i + 1&
Loop
'если не та таблица
If i > vLastRow Then MsgBox "Ошибка формата FCenter", vbExclamation, "Ошибка": Exit Sub
'до конца таблицы
Do Until i > vLastRow
'если признак группы, то получить имя группы
If InStr(LCase$(CStr(Cells(i, 1&).Value)), GroupSign) <> 0& Then
sGroup = CStr(Cells(i, 2&).Value)
i = i + 3& 'смещение до первой записи группы (пропуск шапки)
'получить назавние категории для группы
If Categories.Exists(sGroup) Then
sCategory = Categories.Item(sGroup)
Else
sCategory = "Неопределена"
End If
Else 'иначе запись названия группы
Cells(i, GroupCol).Value = sGroup
Cells(i, CategoryCol).Value = sCategory
i = i + 1&
End If
Loop
End Sub
[/more]

2AndVGri
Спасибо, дружищще!!! Получилось!

Поэкспериментировал, и вот этот вариант у меня сработал:

Dim i As Integer, splitResult() As String
splitResult = VBA.Split(ActiveCell.Value, vbLf)
For i = LBound(splitResult) + 1 To UBound(splitResult) + 1
Worksheets("2").Cells(i, 1) = splitResult(i - 1)
Next i

и ещё одну фишку придумал чтобы сформировать список для Сводной таблицы:

Sub M1()
Columns("C:C").Copy
Columns("H:H").Select
ActiveSheet.Paste
Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=Chr(10), FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
End Sub


ЗЫ. Интересно - нельзя ли добиться такого же результата посредством одних лишь формул, ну там текстовых, индексных функций? Потому что структура таблиц разная встречается, и придёцца заранее предусмотреть все варианты. Это было бы ваще cool.

AndVGri
Спасибо за код. А какой ты прайс скачал? У меня таблица с заголовками и данными вообще-то начинается с 23 строки. В строке написан Прейскурант, а еще выше название фирмы и ее данные. Я попоробовала применить твой код к тому прайсу, что у меня, но ничего не происходит. То, что там нужно подключить, я подключила.

а вот код, что я написала, надо было записать так:
Sub ДобавлениеКатегории()
Dim rst As Integer
Dim i As Integer
Dim k As Variant
Dim w As Worksheet

'определение диапазона
Set w = ActiveSheet
rst = w.UsedRange.Rows.Count
For i = 1 To rst
k = Cells(i, 3)
If CStr(k) <> "" Then
Cells(i, 12) = ExtractElement(k, 1, " ")
End If
Next i

End Sub
Все прекрасно работает. Но вот твой код меня заинтересовал.

Panteran3785

Цитата:

http://www.fcenter.ru/products.shtml?eshop

как вы писали в 99 части или :
http://www.fcenter.ru/products/price/price.zip - собственно полный прайс-лист в html, под него и составлял. Вы, как я понял, использовали прайс-xls конкретного магазина. Видимо в этом разница. Если будете пробовать, то учтите, что html Excel открывает минут 10

Вариант для прайса-xls на Бабушкинской
[more]
Private Const GroupCol As Long = 15&

Public Sub CreateGroupColumn()
Dim vLastRow As Long, vFirstRow As Long
Dim i As Long, sGroup As String
vLastRow = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row - 1&
'поиск строки заголовков по признаку "наименование"
For i = 1& To vLastRow
If LCase$(CStr(Cells(i, 3&).Value)) = "наименование" Then
vFirstRow = i: Exit For
End If
Next i
'поиск начала данных по непустой ячейке в столбце А
For i = vFirstRow To vLastRow
If Trim$(CStr(Cells(i, 1&).Value)) <> "" Then
vFirstRow = i: Exit For
End If
Next i

'собственно цикл вывода групп
For i = vFirstRow To vLastRow
'если ячейка в А не пуста, то наименование группы
If Not IsEmpty(Cells(i, 1&).Value) Then
sGroup = CStr(Cells(i, 1&).Value)
'если ячейка в С не пуста, то записываем название группы
ElseIf Not IsEmpty(Cells(i, 3&).Value) Then
Cells(i, GroupCol).Value = sGroup
End If
Next i
End Sub
[/more]

The okk
Долго не мог участвовать в форуме - лежал в больнице ;((
Попытался поподробней описать свою задачу
Имеется следующая таблица. Как видно в толбце А отображаютя наименования детали, а через две строки ее индетификационный номер. В следующих столбцах (остаток, приход и т.д.) напротив наименования детали сумма, а ниже количество, то же самое напротив индетификационного номера.

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



Добавлено:
что-то не так сделал;((

aks_sv
Файлы сначала нужно выложить в инет, а в теге img указывать ссылку на файл в инете.

звините: неправильно вставил таблицы

AndVGri
Спасибо! Действительно, я использовала xls файл, только прайс для дилеров, но они почти похожи. с Бабушкинским работает. А вот с html немного не понятно. Ты его после открытия экспортировал в Excel или открыл сразу в Excel. может я туплю, но как ни пробовала, все время открывается в html.

Panteran3785
Открыл html в Excel (Файл/Открыть... D:\Temp\price.html) около 10 минут и готово

AndVGri
Попробовала, какую-то абаракадабру выдал, иероглифы, в чем может быть дело?

Panteran3785
Извини, забыл написать. В price.html не стоит определение кодировки. Поставь вот это
<META HTTP-EQUIV="Content-Type" content="text/html; charset=windows-1251">
после <head> в любом текстовом редакторе (не мудри обычный Блокнот).

Drak

Подскажи, как вставить рисунок дилетанту

val_04
Цитата:

Подскажи, как вставить рисунок дилетанту

ничего, если я отвечу? читайте доки - они рулез! Вот из FAQ по RU-Board такое сообщение: Как вставить в сообщение картинку


Добавлено:
При необходимости выложить скриншот пользуйтесь сервисом ImageShack® (ограничение на размер файла <1.5 Mb)

The okk
Имеется следующая таблица. Как видно в толбце А отображаютя наименования детали, а через две строки ее индетификационный номер. В следующих столбцах (остаток, приход и т.д.) напротив наименования детали сумма, а ниже количество, то же самое напротив индетификационного номера.

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

aks_sv
Что-то типа как бы так возможно
[more]
Public Sub Convert()
Dim pSource As Worksheet, pCell As Range
Dim pDest As Worksheet
Dim i As Long, pos As Long

Set pSource = ActiveSheet
Set pDest = Worksheets.Add
For i = 4& To pSource.UsedRange.Rows.Count - 3& Step 4&
pos = pos + 1&
Set pCell = pSource.Cells(i, 1&)
pDest.Cells(pos, 1&).Value = pCell.Value
pDest.Cells(pos, 2&).Value = pCell.Offset(2&, 0&).Value
pDest.Cells(pos, 3&).Value = pCell.Offset(1&, 1&).Value
pDest.Cells(pos, 4&).Value = pCell.Offset(0&, 1&).Value
pDest.Cells(pos, 5&).Value = pCell.Offset(1&, 2&).Value
pDest.Cells(pos, 6&).Value = pCell.Offset(0&, 2&).Value
pDest.Cells(pos, 7&).Value = pCell.Offset(1&, 3&).Value
pDest.Cells(pos, 8&).Value = pCell.Offset(0&, 3&).Value
Next i
End Sub
[/more]

AndVGri

Премного благодарен

Добавлено:
AndVGri
Если можно еще вопрос: Каксделать чтоб записи в новом листе начинались со второй строчки?

aks_sv
написать перед For
pos = 1&

Задумался над задачей на тему Evaluate:
В столбце А какие-то произвольные данные. Если в столбце B мы в каждую ячейку поставим формулу =ЕТЕКСТ(A:A), она будет работать - будут браться значения столбца А из той же строки. Однако, если попытаться сделать вот такой финт:

Код: [A:A]=[ISTEXT(A:A)]

The okk
А о коде несколько поподробнее? И к чему финт?

AndVGri

Цитата:

А о коде несколько поподробнее?

Часто возникают ситуации, когда нужно что-то сделать с ячейками, для которых выполняется какое-либо условие (обычно их надо удалить). Например:
удалить все строки, в которых (есть неуникальное значение в столбце А)И(в столбце B какая-нибудь ошибка, допустим Н/Д).
Очевидное решение - пройти в цикле по всем ячейкам мне не кажется удачным, поскольку во-первых, это цикл(!), во-вторых, это цикл по ячейкам.
Допустим, со второй проблемой справиться легко - достаточно взять все значения столбцов А и В в массив (a = [A:B]), подключить Dictionary и пройтись по элементам, проверяя для каждого уникальность (Dictionary нужен для проверки существования дубликатов), после чего выгрузить полученный почищенный массив в исходные столбцы (точнее, в их Value). Да, способ простой и быстрый. Но это все равно цикл.
Мой вариант - в столбец А записать "" везде, где выполняется условие. Т.е.:
=ЕСЛИ(И(СЧЁТЕСЛИ(A:A;A:A)>1;ЕОШИБКА(B:B));"";(A:A))
Если запишем это в столбец после последнего, будем иметь там пустые ячейки и непустые. Т.е. можно сразу взять SpecialCells(xlCellTypeBlanks).EntireRow и Delete. Сразу! Все! Без цикла!
Однако, зачем создавать доп.столбец, писать туда формулу, если можно сразу записать это в столбец А. В виде формулы записать не получится, поскольку возникнет циклическая ссылка. А вот если .Value=Evaluate, то вполне прокатит (уже так делал). Вопрос в том, что записать в Evaluate, ведь
=ЕСЛИ(И(СЧЁТЕСЛИ(A:A;A:A)>1;ЕОШИБКА(B:B));"";(A:A))
в данном случае уже не прокатит.

Здравствуйте!

У меня есть рабочая книга с макросами, в которой я создаю рабочие листы.

У меня вопрос: Как сохранить книгу с листами которые я создал. Имеется ввиду данные без формул, чтоб не сохранять весь макрос, чтоб пользователю были доступни листы с данними.

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

The okk
Похоже с Evaluate или чем-то подобным ничего не выйдет. А чем так плох цикл?
Можно, используя тот же Dictionary, собирать в Union ячееки с повторяющимися значениями. Затем, по приведённому примеру, через SpecialCells(xlCellTypeVisible, xlErrors) получить Range ячеек с ошибками найти пересечение Intersection и, далее, через EntireRow.Delete удалить

Добавлено:
Несколько описался
Intercection надо будет искать с Union.EntireRow
И маленький вопрос, а данные в столбце А уже не нужны, раз результат Evaluate записывается в А:А?

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

AndVGri

Цитата:

написать перед For
pos = 1&

А можно поподробней, видемо совсем валенок

AndVGri
[q][/q]Поставь вот это
<META HTTP-EQUIV="Content-Type" content="text/html; charset=windows-1251">

А где это сохранить? Пока ничего не получается.

Panteran3785
Открываешь price.html в Блокноте. В Проводнике на файле price.html (html - расширение может не отображаться, если не включены настройки отображения расширений) нажимаешь правую клавишу мыши, выбираешь "открыть с помощью" в списке программ выбираешь Блокнот (notepad)
В открывшемся файле построчно
<html>
<head>
вот после этого <head> и вставляешь <META HTTP-EQUIV="Content-Type" content="text/html; charset=windows-1251">. Закрываешь блокнот и на запрос "сохранить изменения?" отвечаешь Да, конечно. После чего открываешь в Excel Файл/Открыть

Добавлено:
aks_sv

Код:
Set pDest = Worksheets.Add
pos = 1& 'Вот здесь, например
For i = 4& To pSource.UsedRange.Rows.Count - 3& Step 4&

AndVGri

Цитата:

pos = 1& 'Вот здесь, например

кстати, использовать то, что при декларировании в переменную заносится 0 - не совсем честно... ;-)))

SERGE_BLIZNUK

Цитата:

использовать то, что при декларировании в переменную заносится 0 - не совсем честн

Если декларировали не Static, то совсем честно.


Цитата:

Похоже с Evaluate или чем-то подобным ничего не выйдет. А чем так плох цикл?

Тем, что хороший код VBA должен максимально использовать возможности Excel, т.е. Dictionary, RegExp и т.д. нужно использовать, когда средствами Excel что-то сделать либо очень сложно, либо вообще невозможно. Даже пустой цикл с проходом по ячейкам может занять довольно много времени.

Цитата:

И маленький вопрос, а данные в столбце А уже не нужны, раз результат Evaluate записывается в А:А?

Ну сам посуди. Если там просто ячейки с константами, то если мы запишем туда A:A, ничего не изменится. Если, например, запишем (каким-либо образом) [IF(ISTEXT(D:D),"",A:A)], то в ячейках, напротив которых в столбце D есть текст, будет пусто, а там, где напротив - не текст, останется то же самое значение. Исчезнут значения только в тех строках, которые все равно будут удалены. Так что, в данном конкретном случае, данные в A:A нам нужны, но не все.