» Excel VBA (часть 3)

Хотя нет, так как раз работает.

Добрый день, подскажите, пожалуйста.
Надо написать макрос.
Есть таблица
Article    Size
3930104    98110
     116128
3930303    98110
     116128
3979905     .
3990102    0
4127231     L
     M
     S
     XL
     XS
     XXL
4127232     L
     M
     S
     XL
     XXL


Нужно в результате получить таблицу вида:


Article    Size
3930104    98110, 116128
3930303    98110, 116128
3979905    No size
3990102    No size
4127231    XS, S, M, L, XL, XXL
4127232    S, M, L, XL, XXL

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


Код: Sub Range1
Dim cel As Range

For Each cel In Selection
If cel.Offset(1, 0) = "" Then cel.Offset(1, 0) = cel
Next

End Sub

Цитата:

А вот вторую часть осилить не могу.   Помогите, пожалуйста!)

Объяснять долго. Скачайте вот это: http://rghost.ru/43637891

Добрый вечер.
В ячейке А1 занесено число "1/250", в В1 "2/150". Подскажите, возможно ли сложить данные соответственно таким образом, чтобы в ячейке С1 получилось "3/400"? Знак "/" в данном случае не знак деления, а как бы разделитель самих чисел.

psiho

Цитата:

Объяснять долго. Скачайте вот это: http://rghost.ru/43637891

Огромное спасибо!!!

Цитата:

Подскажите, возможно ли сложить данные соответственно таким образом, чтобы в ячейке С1 получилось "3/400"

Конечно можно. Почитайте справку Excel по формулам: "ЛЕВСИМВ", "ПСТР", "ЧИСЛО" и "НАЙТИ"

Задача:

Просмотреть все ячейки в первой строке (A1, B1, C1 и т.д.) до первой пустой и вывести их текст.

Делаю [more=так]
Dim Str2 As String
Dim I As String
Sub mk1()

I = 0
Str2 = "Dummy"

Do While Str2 <> ""
I = I + 1
Str2 = Sheets("Лист1").Cells(1, I).Value '*
MsgBox (Str2)
Loop

End Sub
[/more]

Получаю ошибку Error 1004 Application defined or object defined error - ругается на строку * в цикле. Если вместо I стоит число то все работает. Но нужно передать именно I. Объявление её как Public не помогло. Прошу помощи.

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

Dmitriy05
Dim I As Integer

sinden
Нужно включить в настройках вкладку разработчик на ленте (Раздел "Основные"), а дальше в ней найти и вставить на лист элемент ActiveX "Кнопка".
Подробнее: http://office.microsoft.com/ru-ru/excel-help/HA101819080.aspx


Добавлено:
Leojse
Если цифры одинаковые, можно так (в С1):
=СУММ(ЛЕВСИМВ(A1;1);ЛЕВСИМВ(A2;1)) & "/" & СУММ(ПРАВСИМВ(A1;3);ПРАВСИМВ(A2;3))
Если нет, нужно вместо ЛЕВСИМВ и ПРАВСИМВ использовать ПСТР - она позволяет извлечь часть нужной строки, например:
=СУММ(ПСТР(A1;1;НАЙТИ("/";A1;1)-1);ПСТР(A2;1;НАЙТИ("/";A2;1)-1))
дальше аналогично.

andrewkard1980 спасибо Тебе за информацию с Уважением Денис.

aidomars
Проглядел тип переменной
Спасибо!

Здравствуйте всем встретился с такой проблемой есть два прайсы в якикихе по два столбца в каждом название и цена, идя по порядку в прайсе "A" я ищу такое же название в прайсе "Б" есть в прайсе "А" продукт под номером 1 а в прайсе "Б" может быть под любым номером зависимости где он найдется поиском. Следующий шаг я перевожу курсор на 1 ячейку в лево от активной но и сравниваю цену в прайсе "А" и "Б" тогда просто записываю ту цену которая меньше в прайс "А" из прайса "Б" или оставляю таким же если она ниже соответствующую цену в прайсе "Б".
Так вот в чем моя проблема:
Я написал алгоритv который это выполняет но никак не могу понять как мне в поиск записывать поочередно из прайса "А" ячейки 1,2,3,4, т.е. их значение для поиска в прайсе "Б" и изменения цены? ВОТ КОД


Добавлено:


Добавлено:


Код:
Sub Макрос13()
'
' Макрос13 Макрос
'

''
For i = 1 To 12

Sheets(3).Rows("1:12").Columns("A").Cells(i + 1).Copy

Sheets(4).Select

Range("A1:A13").Select
Selection.Find(What:=Insert, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select


ActiveCell.Offset(0, 1).Select

If ActiveCell.Value > _
Sheets(3).Rows("1:12").Columns(2).Cells(i + 1).Value _
Then ActiveCell.Value = _
Sheets(3).Rows("1:12").Columns(2).Cells(i + 1).Value


Next
End Sub

SokeOner
Пробуйте так:

Код:
Sub test()
Dim aNA(), aNB(), aPA(), aPB()
Dim i&, l&

aNA() = Range("A1:A34") ' Название продуктов из прайса А
aNB() = Range("E1:E34") ' Название продуктов из прайса Б
aPA() = Range("B1:B34") ' Цены из А
aPB() = Range("F1:F34") ' Цены из Б

For i = 1 To UBound(aNA)
For l = 1 To UBound(aNB)
If aNA(i, 1) = aNB(l, 1) Then
aPA(i, 1) = Application.WorksheetFunction.Min(aPA(i, 1), aPB(l, 1))
End If
Next l
Next i

Range("H1:H34") = aNA ' Выводим название продуктов из прайса А
Range("I1:I34") = aPA ' Выводим мин. цены
End Sub

можно сделать идентичен поиск только без учета знаков препинания тоесть запятых, точек, пробелов, черточек ТОЕСТЬ: "ERGO _V T-9-01 W_hite" равносильно "ERGOVT901White" этом "ERGO W T901 White" и этом "ERGO V Т-901 White ".

Добавлено:
такое вот вопрос можно сделать не идентичный поиску типа если в строке записано "бла бла бал бал Genius 35 svt 75 бла бла бла бла" а мен надо найти только "Genius 35 svt 75"? ну и так как в том вопросе что было предыдущее не учитывая знаки понктуации?

SokeOner
Как то так:

Код: Sub test()
Dim aNA(), aNB(), aPA(), aPB()
Dim i&, l&
Dim sA$, sB$

aNA() = Range("A1:A34")
aNB() = Range("E1:E34")
aPA() = Range("B1:B34")
aPB() = Range("F1:F34")

For i = 1 To UBound(aNA)
For l = 1 To UBound(aNB)
sA = aNA(i, 1)
sB = aNB(l, 1)

sA = Replace(sA, ".", "")
sA = Replace(sA, ",", "")
sA = Replace(sA, "-", "")
sA = Replace(sA, " ", "")
sA = Replace(sA, "_", "")

sB = Replace(sB, ".", "")
sB = Replace(sB, ",", "")
sB = Replace(sB, "-", "")
sB = Replace(sB, " ", "")
sB = Replace(sB, "_", "")

If sB Like "*" & sA & "*" Or sA Like "*" & sB & "*" Then
aPA(i, 1) = Application.WorksheetFunction.Min(aPA(i, 1), aPB(l, 1))
End If
Next l
Next i

Range("H1:H34") = aNA
Range("I1:I34") = aPA

End Sub

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

Есть пустая ячейка для которой одновременно:
(C2="") = ИСТИНА
СЧЕТЕСЛИ(C2;"<>""") = 1

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

Может как то так:
=ЕСЛИ(СЧЁТЕСЛИ(C:C;">0")+СЧЁТЕСЛИ(C:C;">*")=1;1;0)

Dmitriy05
Например, Так:

Код: Sub qq()
Dim i As Integer
For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
If Intersect(Columns(i), Rows("2:" & Rows.Count)).Text = "" Then Columns(i).Delete
Next
End Sub

Dmitriy05
=(СЧИТАТЬПУСТОТЫ(Диапазон)=ЧСТРОК(Диапазон))

Добавлено:
SAS888
Проверять текст ячейки, когда нужны данные, вообще, очень плохая идея. Например, задайте для ячейки формат "#;" и введите туда -100. Ваша программа определит ее как пустую. ("Видишь суслика? ... А он есть!"). Равно как и наоборот, ячейка с заданной маской формата, в которую введена пустая строка, будет считаться заполненной.

panda3

Цитата:

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

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

Код: Sub qq()
Dim i As Integer
For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
If Application.CountA(Columns(i)) = 1 Then Columns(i).Delete
Next
End Sub

andrewkard1980
Работает, но ячейки с пробелами считает не как содержащие значения.

SAS888
Быстро отработало. Не проверял на пробелы.

panda3
Для колонки только с заголовком:
СЧИТАТЬПУСТОТЫ возврашает 65535
а ЧСТРОК должно показать 65536 - надо проверить что выдаст у меня.


Цитата:

удалить требуемые столбцы формулами не осуществить...

Почему нет?
У меня заработал такой код:

Код:
Dim Str1 As String
Dim Str2 As String
Dim Totalrows as integer
Dim EmptyRows
Dim X As Integer
Sub DelEmptyColumns()
x = 1
Str2 = "Dummy"
Do While Str2 <> ""
Str2 = Sheets("Лист1").Cells(1, x).Value
TotalRows:= Application.WorksheetFunction.CountIf(Columns(x),"<>''")
EmptylRows:= Application.WorksheetFunction.CountBlank(Columns(x))
If (TotalRows - EmptylRows) = 1
Then
Columns(x).Delete
Else
x = x + 1
End If
Loop
End Sub

Dmitriy05
Много лишнего. Чем Вас не устраивает предложенный мною вариант? При его выполнении будут удалены все столбцы на активном листе, в которых кроме заголовка, расположенного в 1-й строке, нет данных. Пробел считается за действительное значение. Если столбцов много, то, целесообразно в начало кода поместить строку
Код: Application.ScreenUpdating = False

SAS888
Скрипт из 7го сообщения выдает ошибку 1004 (Application or object-defined error) на некоторых колонках:

1) Содержащие числа, отформатированные как текст
2) Без указания формата (так было выгружено)

Имейте в виду, что CountA считает и пустые строки тоже.
Dmitriy05
а зачем два раза считать? и зачем все строки листа считать? я бы так написал:

Код: Dim c As Range, d As Range
For Each c In ActiveSheet.UsedRange.Columns
If WorksheetFunction.CountBlank(c) = c.Rows.Count - 1 Then
If d Is Nothing Then Set d = c Else Set d = Union(d, c)
End If
Next c
If Not d Is Nothing Then d.Delete

panda3
"Метод Delete из класса Range завершен неверно"

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

igorsimerin
Может стоит сразу открывать в режиме "только чтение"?

Как в VBA определить время простоя компьютера?

Добавлено:
Нашел

Код: Declare Function GetLastInputInfo Lib "USER32.DLL" (plii As LASTINPUTINFO) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type

Function Interval()
Dim plii As LASTINPUTINFO
plii.cbSize = Len(plii)
Call GetLastInputInfo(plii)
Interval = FormatNumber((GetTickCount() - plii.dwTime) / 1000, 2)
End Function

[more] Добрый день!

Прошу прощения за вопрос, но я в VBA очень не сильна.

Нужна программа сверяющая ячейки в 2 столбиках (скажем, j,l) с проверочными (b,d) одновременно. Т.е. сверить строчку i колонки j со всеми значениями колонки b, если совпадение найдено в строчке a колонки b, то проверяем ячейку (i,l) c (a,d) в той же строчке.
Если сочетание такое в одной строчке найдено, то в строчке i присвоить в колонке y значение 1, а если нет, то 0.

Но что-то ему все время не нравится(( Помогите, пожалуйста! Заранее большое спасибо.

[more=Макрос]
Код: Public Sub check()

Dim a As Integer, b As Integer, i As Integer, j As Integer, l As Integer, y As Integer, d As Integer

j = CInt(InputBox("Enter column lic number"))
l = CInt(InputBox("Enter column data number"))
b = CInt(InputBox("Enter column lic check"))
d = CInt(InputBox("Enter column data check"))
y = CInt(InputBox("Enter column default"))

i = 0
Do
i = i + 1
a = 0
Do
a = a + 1
If Cells(i, j) = Cells(a, b) Then
Do
k = k + 1
If Cells(k, l) = Cells(a, d) Then
Cells(i, y) = 1
Exit Do
Else
Cells(i, y) = 0
End If
Else
Cells(i, y) = 0
End If
Loop Until cells (a,b)=""
Loop Until cells (i,j)=""
End Sub