» Excel VBA (часть 3)

и у меня все ок
andrewkard1980 надо отдать должное. Топик только на нем и держится. Очень много задач помог облегчить.

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


далее макрос описывает только красные корреляции. Т.е. вбить в макрос вводную фразу при проведении корреляционного анализа были полученные статистически достоверные зависимости , так , самоконтроль положительно коррелирует с ЛК-жизнь (а в скобках коэф.корреляции т.е. r=0,30, p<0,05) тут везде p<0,05, после аналогичным образом пишет про другие достоверные корреляции, например поиск соц.поддержки положительно коррелирует с локус Я(r=0,37, p<0,05), если перед коэффициентом стоит минус, то надо прописать так.
самоконтроль отрицательно коррелирует с ЛК-жизнь (а в скобках коэф.корреляции т.е. r=-0,30, p<0,05)
Такое можно сделать или нет.
матрица тут
http://rghost.ru/58939149

Fsp050
Можно, например так:

Код:
Sub CorrDescription()
Dim sNmCl$, sNmRw$, sStr$
Dim r As Range
sStr = "При проведении корреляционного анализа были полученные статистически достоверные зависимости, так, "
For Each r In Selection
If r.Font.ColorIndex = 3 Then
sNmCl = Cells(1, r.Column).Value
sNmRw = Cells(r.Row, 1).Value
If r.Value >= 0 Then
sStr = sStr & sNmCl & " положительно коррелирует с " & sNmRw & " (r = " & Application.Round(r.Value, 2) & ", p<0,05), "
Else
sStr = sStr & sNmCl & " отрицательно коррелирует с " & sNmRw & " (r = " & Application.Round(r.Value, 2) & ", p<0,05), "
End If
End If
Next
sStr = Left(sStr, Len(sStr) - 2) & "."
Cells(Cells(Rows.Count, "A").End(xlUp).Row + 2, 1) = sStr
End Sub

andrewkard1980, здоровски)) Спасибо Вам. Работает. А можете, пожалуйста, внести пару корректировок.
Дело в том, что есть дублирование , например
var3 положительно коррелирует с var1 (r = 0,79, p<0,05)
и
var1 положительно коррелирует с var3 (r = 0,79, p<0,05)
и так далее. Это просто повторное описание

И такой вопросик. Если я правильно понял, вы немного разбираетесь в статистике. Положительная корреляция означает что чем больше одно тем больше второе. Например чем больше коммуникабельность , тем больше дружелюбность, а отрицательная наоборот чем меньше коммуникабельность тем больше замкнутость, но это такая элементарнейшая линейная зависимость. Можно ли заставить компутер делать выводы, т.е. вот он описал ,что вар 1 коррелирует с вар3, а вар 4 коррелирует с вар 5......... ,а далее вводная фраза Таким образом мы можем сделать вывод, что: (смотрим с чем и как связана сначала первая переменная)
чем больше у человека вар1, тем больше у него выражено вар3, а также вар 4 , а также вар 6 и меньше у него выражено вар5(зависит от знака корреляции), после как все зависимости с вар 1 прописались переходим к след. переменной и в таком же духе, чем больше у человека там вар 3, тем больше вар 4 и меньше вар 5.

Fsp050

Цитата:

Это просто повторное описание

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

Код:
Sub CorrDescription()
Dim sNmCl$, sNmRw$, sStr$
Dim r As Range
Dim oDict: Set oDict = CreateObject("Scripting.Dictionary"): oDict.CompareMode = vbBinaryCompare
sStr = "При проведении корреляционного анализа были полученные статистически достоверные зависимости, так, "
For Each r In Selection
If r.Font.ColorIndex = 3 Then
sNmCl = Cells(1, r.Column).Value
sNmRw = Cells(r.Row, 1).Value
If oDict.Exists(sNmCl & sNmRw) = False And oDict.Exists(sNmRw & sNmCl) = False Then
If r.Value >= 0 Then
sStr = sStr & sNmCl & " положительно коррелирует с " & sNmRw & " (r = " & Application.Round(r.Value, 2) & ", p<0,05), "
Else
sStr = sStr & sNmCl & " отрицательно коррелирует с " & sNmRw & " (r = " & Application.Round(r.Value, 2) & ", p<0,05), "
End If
oDict.Item(sNmCl & sNmRw) = 1
oDict.Item(sNmRw & sNmCl) = 1
End If
End If
Next
sStr = Left(sStr, Len(sStr) - 2) & "."
Cells(Cells(Rows.Count, "A").End(xlUp).Row + 2, 1) = sStr
End Sub

andrewkard1980, а теперь все как всегда впорядке

а по поводу
Цитата:

заставить компутер делать выводы, т.е. вот он описал ,что вар 1 коррелирует с вар3, а вар 4 коррелирует с вар 5......... ,а далее вводная фраза Таким образом мы можем сделать вывод, что:  (смотрим с чем и как связана сначала первая переменная)
чем больше у человека вар1, тем больше у него выражено вар3, а также вар 4 , а также вар 6 и меньше у него выражено вар5(зависит от знака корреляции), после как все зависимости с вар 1 прописались переходим к след. переменной и в таком же духе, чем больше у человека там вар 3, тем больше вар 4 и меньше вар 5.

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

Добрый вечер, уважаемые форумчане! Буду очень признателен за любую помощь в данном вопросе. Есть две книги, с которых собираются данные в сводную книгу. Помогите, пожалуйста, поправить макрос так, чтобы при сборе данных из книги 1, данные не копировались в сводную книгу, имеющих условие в виде даты (то есть, на пример, не должен копироваться адрес Нефедова 31в - 2, и Нефедова 31в-25 в сводную, так как есть условие в виде даты). Данные с условием в виде даты из книги 2 не копируются в сводную, но не знаю, как прописать также, чтобы такие данные с условием не копировались и из первой книги.
Заранее огромнейшее спасибо за любую помощь!
http://rghost.ru/59047772

Добрый день, друзья!

Есть документ xls с настроенным макросом. В этой таблице формируется отчет поэтажного плана из графической программы. В настоящий момент таблица формирует отчет только по одному этажу, даже если выделены, скажем, с 1 по 17. То есть, действует это ограничение.

Задача: нужно, чтоб формировался отчет по всем этажам. То есть, устранить это ограничение.

Подскажите, как это сделать?
Заранее спасибо!




Вот содержание таблицы:

' PlanCAD Automation Sample
' Copyright (C) 2010 by Consistent Software, Inc.

Option Explicit

' вызывается из Планкад
Sub PT_RunFunc(Objects As PTObjects, ptApp As PTApplication)
Dim floor As PTFloor
If Objects.Count > 0 Then
Dim obj As IPTObject
For Each obj In Objects
If obj.Type = ptObjTypeFloor Then
Set floor = obj
Exit For
End If
Next
End If

If Not floor Is Nothing Then
UpdateReport floor, ptApp
Else
MsgBox "Неверные данные!"
End If
End Sub

' обновить отчет по этажу
Sub Update()
' получить модель плана
Dim ptApp As PTApplication
Set ptApp = GetPlanModel

' получить этаж по номеру
Dim floor As PTFloor
Set floor = GetFloorById
If floor Is Nothing Then
MsgBox "Нет этажа с таким номером!"
Exit Sub
End If

' обновить
Sheets("Экспликация этажа").Select
UpdateReport floor, ptApp

End Sub

' обновить отчет по этажу
Sub UpdateReport(floor As PTFloor, ptApp As PTApplication)

' площади этажа
Dim totalArea As Double, flatArea As Double
Dim livingArea As Double, subsdArea As Double, balcArea As Double
totalArea = flatArea = livingArea = subsdArea = balcArea = 0#

' заполняем данные по помещениям и входящим в них комнатам
Dim row As Integer
row = 12
Dim obj As IPTObject
For Each obj In floor.Objects
' квартира
If obj.Type = ptObjTypeFlat Then
UpdateFlat obj, floor, totalArea, flatArea, livingArea, subsdArea, balcArea, row
End If
Next

' вспомогательные чп (не входящие в помещения)
UpdateRooms floor.Objects, Nothing, floor, totalArea, flatArea, livingArea, subsdArea, balcArea, row

' &#232;&#242;&#238;&#227;&#238;
Cells(row, 1).Formula = ""
Cells(row, 2).Formula = floor.floorId
Cells(row, 3).Formula = ""
Cells(row, 4).Formula = ""
Cells(row, 5).Formula = ""
Cells(row, 6).Formula = ""
' площадь с учетом неотапливаемых &#247;&#239;
If totalArea > 0 Then Cells(row, 7).Formula = totalArea Else Cells(row, 7).Formula = ""
' общая площадь
If flatArea > 0 Then Cells(row, 8).Formula = flatArea Else Cells(row, 8).Formula = ""
' жилая
If livingArea > 0 Then Cells(row, 9).Formula = livingArea Else Cells(row, 9).Formula = ""
' подсобная
If subsdArea > 0 Then Cells(row, 10).Formula = subsdArea Else Cells(row, 10).Formula = ""
' лоджий, балконов
If balcArea > 0 Then Cells(row, 11).Formula = balcArea Else Cells(row, 11).Formula = ""
' высота
Cells(row, 12).Formula = floor.Height
Cells(row, 13).Formula = ""
Cells(row, 14).Formula = ""
row = row + 1

' clear last records
While Cells(row, 2).Formula <> "" Or Cells(row, 3).Formula <> "" Or Cells(row, 4).Formula <> ""
Range(Cells(row, 1), Cells(row, 14)).ClearContents
row = row + 1
Wend

End Sub

' обновить информацию о помещении
Sub UpdateFlat(flat As PTFlat, floor As PTFloor, ByRef totalArea As Double, ByRef flatArea As Double, ByRef livingArea As Double, ByRef subsdArea As Double, ByRef balcArea As Double, ByRef row As Integer)

' части помещения
Dim flatTotalArea As Double, flatFlatArea As Double
Dim flatLivingArea As Double, flatSubsdArea As Double, flatBalcArea As Double
flatTotalArea = flatFlatArea = flatLivingArea = flatSubsdArea = flatBalcArea = 0#
UpdateRooms flat.Objects, flat, floor, flatTotalArea, flatFlatArea, flatLivingArea, flatSubsdArea, flatBalcArea, row

' итого
Cells(row, 1).Formula = ""
Cells(row, 2).Formula = floor.floorId
Cells(row, 3).Formula = flat.FlatId
Cells(row, 4).Formula = ""
Cells(row, 5).Formula = ""
Cells(row, 6).Formula = ""
' площадь с учетом неотапливаемых&#247;&#239;
If flatTotalArea > 0 Then Cells(row, 7).Formula = flatTotalArea Else Cells(row, 7).Formula = ""
'общая площадь
If flatFlatArea > 0 Then Cells(row, 8).Formula = flatFlatArea Else Cells(row, 8).Formula = ""
' жилая
If flatLivingArea > 0 Then Cells(row, 9).Formula = flatLivingArea Else Cells(row, 9).Formula = ""
' подсобная
If flatSubsdArea > 0 Then Cells(row, 10).Formula = flatSubsdArea Else Cells(row, 10).Formula = ""
' лоджий, балконов
If flatBalcArea > 0 Then Cells(row, 11).Formula = flatBalcArea Else Cells(row, 11).Formula = ""
' высота
Cells(row, 12).Formula = flat.Height
Cells(row, 13).Formula = ""
Cells(row, 14).Formula = ""

totalArea = totalArea + flatTotalArea
flatArea = flatArea + flatFlatArea
livingArea = livingArea + flatLivingArea
subsdArea = subsdArea + flatSubsdArea
balcArea = balcArea + flatBalcArea
row = row + 1

End Sub

' обновить части помещения
Sub UpdateRooms(rooms As PTObjects, flat As PTFlat, floor As PTFloor, ByRef totalArea As Double, ByRef flatArea As Double, ByRef livingArea As Double, ByRef subsdArea As Double, ByRef balcArea As Double, ByRef row As Integer)

Dim obj As IPTObject
For Each obj In rooms
If obj.Type = ptObjTypeRoom Then
Dim room As PTRoom
Set room = obj
If (flat Is Nothing) = (room.flat Is Nothing) Then
' литера
Cells(row, 1).Formula = room.Litera
' этаж
If Not floor Is Nothing Then Cells(row, 2).Formula = floor.floorId Else Cells(row, 2).Formula = ""
' помещение
If Not flat Is Nothing Then Cells(row, 3).Formula = flat.FlatId Else Cells(row, 3).Formula = ""
' номер &#247;&#239;
Cells(row, 4).Formula = room.RoomId
' назначение
Cells(row, 5).Formula = room.Description
' формула
Cells(row, 6).Formula = room.area.Formula
' &#239;&#235;&#238;&#249;&#224;&#228;&#252; &#247;&#239;
Dim roomArea As Double
roomArea = FormatNumber(room.area, 1)
'площадь с учетом неотапливаемых чп
Dim area As Double
area = FormatNumber(roomArea * room.AreaFactor, 1)
totalArea = totalArea + area
If area > 0 Then Cells(row, 7).Formula = area Else Cells(row, 7).Formula = ""
'общая площадь
If room.AreaCategory = ptAreaCategoryLiving Or room.AreaCategory = ptAreaCategorySubsidiary Then
area = FormatNumber(roomArea * room.AreaFactor, 1)
flatArea = flatArea + area
Else
area = 0#
End If
If area > 0 Then Cells(row, 8).Formula = area Else Cells(row, 8).Formula = ""
' жилая
If room.AreaCategory = ptAreaCategoryLiving Then
area = roomArea
livingArea = livingArea + area
Else
area = 0#
End If
If area > 0 Then Cells(row, 9).Formula = area Else Cells(row, 9).Formula = ""
' подсобная
If room.AreaCategory = ptAreaCategorySubsidiary Then
area = FormatNumber(roomArea * room.AreaFactor, 1)
subsdArea = subsdArea + area
Else
area = 0#
End If
If area > 0 Then Cells(row, 10).Formula = area Else Cells(row, 10).Formula = ""
' лоджий, балконов
If room.AreaCategory = ptAreaCategoryCold Then
area = FormatNumber(room.area * room.AreaFactor, 1)
balcArea = balcArea + area
Else
area = 0#
End If
If area > 0 Then Cells(row, 11).Formula = area Else Cells(row, 11).Formula = ""
' высота
Cells(row, 12).Formula = room.Height
Cells(row, 13).Formula = ""
Cells(row, 14).Formula = ""
row = row + 1
End If
End If
Next
End Sub

' возвращает этаж по номеру
Function GetFloorById(sFloorId As String, ptApp As PTApplication) As PTFloor
Set GetFloorById = Nothing
Dim floor As PTFloor
For Each floor In ptApp.ObjectsByType(ptObjTypeFloor)
If floor.floorId = sFloorId Then
Set GetFloorById = floor
Exit For
End If
Next
End Function

' returns the plan model
Function GetPlanModel() As PTApplication
Dim app
Set app = CreateObject("PlanCad.Application")
app.Visible = True
Set GetPlanModel = app.Documents.ActivePlanModel
End Function

Подскажите, пожалуйста, как решить такую задачу. Она формулами точно не решается. Я пробывал. но для профессионалов, которые любят решать что-то неординарное, она понравится, 100%.
необходимо подсчитать веса слов вот по этой формуле

Ni,k это сколько раз то или иное слово появилось в одном параграфе.
параграф имеется ввиду, там где есть красная строка


Nk-сколько раз то или иное слово появилось во всем тексте
|D| это количество параграфов
Ni,s означает, что в знаменателе находится сумма по всем параграфам, кроме рассматриваемого.
т.е. вот есть 10 параграфов, 9 рассматривается, один нет. когда он рассмотрелся и данные по словам, которые в нем есть уже как бы в числителе, все с ним работа закончена, начинаете с другим параграфом из 10, и данные этого первого параграфа учитываются в знаменателе.

Только можно ли встроить функцию, типа мессейдж бокса, чтобы можно было настраивать какое слово можно считать редким, а какое частым.Например, если встретилось больше 10 раз в параграфе, оно частое, а если меньше 3 раз, оно редкое.
например, так, извините за пэинт))

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


на выходе эксель должен показывать нечто вроде
слово 1 0,456
слово 2= 0,999
слово 3= 0,576

Помогите, пожалуйста, написать макрос.
http://rghost.ru/59143337
Там где у чисел стоит звездочка(*) не важно сколько, одна, 2, три звезды то число пометить красным цветом.

Цитата:

Помогите, пожалуйста, написать макрос.
Там где у чисел стоит звездочка(*) не важно сколько, одна, 2, три звезды то число пометить красным цветом.

А зачем Вам макрос? Это же можно сделать простым условным форматированием

psiho
да, можно, но вот удалить звездочку автозаменой нельзя.

Цитата:

да, можно, но вот удалить звездочку автозаменой нельзя.

Как заменить/удалить/найти звездочку

VictorKos
Может глянете, что тут не так я делаю

как тильду не ставлю , ничего не меняется
http://rghost.ru/59235966

Futurism
Снимите галочку "Ячейка целиком"

grinchukav
Спасибо Вам, теперь сработало.

Знающие люди, помогите написать макрос для логирования.

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

Часть с печатью вроде сделала. Баркод сканнируется в синее поле, находится в столбце B, из строки с баркодом заполняется форма на скрытом листе "new_45".
А вот с логированием проблема. Бьюсь весь день, а какая-то ерунда получается.

Пробовала сканнирование перенести на лист "скан". Чтобы по заполненной на этом листе строке происходила печать, а данные в табличку подтягивались с листа с базой "общий список", но так не смогла, подтягиваются только Н/Д. Хотя наверное это более оптимальный вариант...
Помогите, пожалуйста!
Заранее очень признательна.
Ссылка на файл:
https://drive.google.com/file/d/0B16thjjI9osNWlI5T3hlTlZ4b0E/view?usp=sharing

Добавлено:
справилась сама. спасибо

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

http://rghost.ru/59366557
Принцип описания должен следовать такому порядку.

Первоначально мы описываем максимально число. В этом случае: 11 человек (Информация взята из клетки E6), которые принадлежат ко второй группе, по первому вопросу (он первый, т.к. там , цифра 1 стоит в этой колонке I) дали ответ 1, среднее количество людей , а именно 4 Ответили 2 и 3 соответственно (потому что мы имеем такое же количество людей, которые вложили иной ответ, иногда такое бывает)

После этого, макросы будут описывать первую группу максимальные, среднее, минимальные значения, аналогичным способом: в то же время в первой группе: 9 человек поставили ответ 3, и так далее /
Конечно же, я не знаю, как, но макрос должен увидеть, какая цифра может быть большой , а какая средней, и какая минимальной
Обязательно, что после каждого описания таблиц макросы должны указать, что различия стат.лостоверны и эти данные (хи-квадрат = 16,557, р &#8804; 0,05), взяты из соответствующей ячейки
Ну, после описания первого макросы таблицы начинается описать следующим.

На практике это должно быть так
(вводные слова) в изучении взаимосвязи между несколькими качественными характеристиками мы обнаруживаем, что:
Наибольшее количество людей, которые принадлежат к второй группе, а именно 11 человек на первый вопрос ответили 1, средее количество людей, а именно 4 Ответили 2 и 3 соответственно! В то же время (введение слов), наибольшее количество тех, кто принадлежит к первой группе, а именно 9 человек на первый вопрос поставили ответ3 и так далее. Эти различия были статистически значимыми (хи-квадрат = 16,557, р &#8804; 0,05)


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


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

Доброго времени суток!

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


Код:

Dim i As Integer
Dim mystr(1 To 10) As Single
i = 1

Sheets("zvonki").Select
With ActiveSheet
Set Y = .Range("G2:G" & .Cells(.Rows.Count, "G").End(xlUp).Row)
End With

For Each firstCell In Y.Cells.SpecialCells(xlCellTypeVisible)
With firstCell
firstCell.Activate
mystr(i) = ActiveCell.Value
i = i + 1
MsgBox mystr(i)
End With
Next

frb_noname
Какое значение і при ошибке?

i=1

andrewkard1980
а мне не сможете помочь? Только на Вас и надежда

frb_noname

Раз i=1, то скорее всего у вас в первой ячейке видимого диапазона строковый заголовок отфильтрованного столбца таблицы. Да и какой смысл в активации ячейки перед тем как получить её значение? Лучше так.

Код:
For Each firstCell In Y.Cells.SpecialCells(xlCellTypeVisible)
If Application.WorksheetFunction.IsNumber(firstCell.Value) Then
mystr(i) = firstCell.Value
i = i + 1
MsgBox mystr(i)
End If
Next

Как выполнить макрос только на выделенных листах книги?

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

Выполнять макрос для всех страниц книги не подходит.


Код:
Sub DefaultView()
k = ActiveWorkbook.Worksheets.Count
'Настраиваем ширину столбцов
Columns("A:A").Select
Selection.ColumnWidth = 16
Columns("B:B").Select
Selection.ColumnWidth = 70
Columns("C:C").Select
Selection.ColumnWidth = 16
Columns("D:D").Select
Selection.ColumnWidth = 17
Columns("E:E").Select
Selection.ColumnWidth = 7
Columns("F:F").Select
Selection.ColumnWidth = 17
Columns("G:G").Select
Selection.ColumnWidth = 24
'настраиваем границы и устанавливаем фильтр в A4:G5
Range("A4:G5").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous 'тип линии: сплошная
.ColorIndex = 0 'цвет:черный
.TintAndShade = 0 'изменение цвета (темнее или свтлее): без изменений
.Weight = xlThin 'тип линии: тонкая
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A4:G5").AutoFilter
'настраиваем границы и делаем шрифт жирным в A4:G4
Range("A4:G4").Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
'настраиваем выравнивание в шапке таблицы
Range("A4:G4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'настраиваем выравнивание в таблице
Range("A5:G5").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'присваиваем значения шапке таблицы
Range("A4").Value = "Модель"
Range("B4").Value = "Описание"
Range("C4").Value = "Фирма"
Range("D4").Value = "Цена, руб."
Range("E4").Value = "Кол., шт."
Range("F4").Value = "Сумма, руб."
Range("G4").Value = "Примечания"
Range("A3").FormulaR1C1 = _
"=MID(CELL(""filename"",RC),FIND(""]"",CELL(""filename"",RC))+1,31)"
End Sub

подскажите как в экселе найти макрос. он есть, работает, но если пойти во вкладку вид -макросы-то там пустой список.

Futurism

Alt + F11 -- перейдете в редактор кода. Далеко не все отображается в списке макросов, а в редакторе кода -- все

аа точно код нашел

Помогите, пожалуйста, как такие данные
http://rghost.ru/59858540
сделать чтобы они в экселе были во так оформлены
http://rghost.ru/59858673

Futurism
Можно так:

Код: Sub Main()
Dim i As Long, a(): Application.ScreenUpdating = False: ThisWorkbook.Sheets(1).Activate
With Workbooks("Книга21.xlsx").Sheets(1): a = .Range("A2:J" & .Cells(Rows.Count, 1).End(xlUp).Row).Value: End With
For i = 1 To UBound(a, 1): Cells(i + 1, 1).Resize(, 26).Value = Split(Join(Application.Index(a, i, 0), ";"), ";"): Next
End Sub

Futurism, здесь необязательно применять VBA. Первый столбец нужно разделить на 11, значит оставляем после него 10 пустых столбцов. Далее "Данные - Текст по столбцам", в кач-ве разделителя указываем точку с запятой.
Аналогично со 2м и 3м столбцами.