макрос для Excel!

[soulthiefer]

Всем здравствуйте !
оч прошу помоч мне т к сам не настолько знаю VBA ( только самое простое ( )
нужен такой скрипт :
есть 4 колонки с 10-значными числами. в каждой по 30 тыс строк минимум .
нужно сравнить между собой все колонки на совпадение 1 с 2,3,4 ; 2-ю с 1,3,4, ; 3-ю с 1,2,4 и т д и допустим в 5-й колонке выводить число которое совпало , в 6-й колонке - через запятую в каких колонках совпало и в 7-й - сколько совпадений соответственно по колонкам тоже через запятую

форму вывода данных можно варьировать чтоб удобней было , но смысл должен остаться такой !
оч прошу помощи так как мне не осилить такой скрипт вообще ((

Заранее спасибо!!!

[kuznetsovSergey]

Код: Выделить всё

 
Sub Macros()
dim sovp as long
dim kolsovp as long
kolsovp = 0
While Sheets("name_page").Cells(q, 1) <> ""
for i = 1 to 3
if Sheets("name_page").Cells(q, 1).Value = Sheets("SAP").Cells(q, i+1).Value then
sovp = Sheets("SAP").Cells(q, i+1).Value and kolsovp=kolsovp +1
end if
Sheets("name_page").Cells(q, 5).Value = sovp
Sheets("name_page").Cells(q, 6).Value = kolsovp
next i
Wend
End Sub

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

[soulthiefer]

спасибо!!!
только что то не работает ((
в строчке :
While Sheets("name_page").Cells(q, 1) <> ""
откуда берется переменная q если она нигде не определяется и ей ничего не присваевается (
и

if Sheets("name_page").Cells(q, 1).Value = Sheets("SAP").Cells(q, i+1).Value then
говорит ошибка !!!
но я на самом деле вообще не понимаю почему 2 листа используются name_page и SAP когда все на одном листе ?

[Teslenko_EA]

Здравствуйте soulthiefer.
если Ваша задача о таблицах, содержащих в столбцах данные одного типа, её можно попытаться выполнить SQL запросом с применением ADO. Выполнить это можно так:
1 подключите к проекту файла, в котором будет выполняться код библиотеку ADO (меню Tools \ References… -Microsoft ActiveX Data Objects X.X ...).
2. первая строка таблицы должна содержать имена полей используемых в запросе, например: w1, w2, w3, w4, w5...
3. в модуле проекта поместите подобный код:

Код: Выделить всё

Sub updateExcel()
Dim cn As New ADODB.Connection, sVar$
'строка подключения к источнику данных - текущий, сохраненный(!) файл Excel
sVar = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + ThisWorkbook.Path + "\" + _
ThisWorkbook.Name + ";Extended Properties=""Excel 8.0;HDR=Yes"";"
'--------------------------------------------
'запрос в текущем файле выполняется гораздо дольше чем во внешнем
'для внешнего файла строка подключения может выглядеть так:
sVar = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Book1.xls;Extended Properties=""Excel 8.0;HDR=Yes"";"
'--------------------------------------------
'Константа с текстом исполняемого запроса на обновление:
Const sqlUp$ = "UPDATE [Лист1$A1:G50000] as d " + _
"SET d.W5 = IIf([w1]=[w2],'1-2; ','') & IIf([w1]=[w3],'1-3; ','') & IIf([w1]=[w4],'1-4; ','') & " + _
"IIf([w2]=[w3],'2-3; ','') & IIf([w2]=[w4],'2-4; ','') & IIf([w3]=[w4],'3-4; ',''), " + _
"d.W6 = IIf([w1]=[w2],1,0)+IIf([w1]=[w3],1,0)+IIf([w1]=[w4],1,0)+IIf([w2]=[w3],1,0)" + _
"+IIf([w2]=[w4],1,0)+IIf([w3]=[w4],1,0);"
' [Лист1$A1:G50000]  - имя листа и используемый диапазон
'--------------------------------------------
'код открывает соединение с источником данных, выполняет запрос на обновление,
'закрывает соединение и очищает использовавшуюся память
Set cn = New Connection
cn.Open sVar
cn.Execute sqlUp
cn.Close:       Set cn = Nothing
End Sub

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

[Aent]

soulthiefer, а что нужно выводить для случая когда попарно совпадают 2 числа?
Cкажем 1-е = 3-е, а 2-е = 4-е ? Т.е. совпадать ведь могут и 2 числа.
Вообще, постановка не очень чёткая. Если возможно, прицепите файл с примером
правильной выдачи для разных вариантов совпадений.
А вообще, подобные задачи легко решаются без макросов - массивными формулами.
Так в предположении что данные располагаются в столбцах A : D и нет 2-х попарных совпадений, повторяющийся элемент 1-й строки определяется массивной формулой
={ИНДЕКС(A1 : D1;1;ПОИСКПОЗ(МАКС(СЧЁТЕСЛИ($A1:$D1;A1 : D1));СЧЁТЕСЛИ($A1:$D1;A1 : D1);0))}

[soulthiefer]

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

[Aent]

soulthiefer, насчёт "сранения с остальные" совсем запутали. Так что вы сравниваете:
числа в колонках ? знаки в 10 значных числах ? цифры в 10 символьных строках ?
Ваш пример ещё больше всё запутал
Непонятно что что стоит в колонках F : I и откуда взялись строки с 5 по 8
Если хотите помощи - опубликуйте внятное описание постановки задачи
на нормальном русском языке.
Пока, к сожалению, его нет ...

[mc-black]

soulthiefer, совершенно согласен с Aent, Вы ничего не объяснили, а только все запутали:
1. В первоначальном описании: 1-4 столбцы исходные 10-значные чисела.
В файле примера НЕТ ни одного 10-значного числа.
2. В первоначальном описании: 5-7 столбцы для вывода результатов (построчно)
В файле примера НЕТ ничего в 5-м столбце и вообще там не то.
Поэтому на "Заранее спасибо!!!" вам можно сказать "Заранее пожалуйста, обращайтесь ещё!!!". Если честно, с таким описанием вам никто и за деньги делать не будет, а вы хотите помощи на халяву. Тем более если Вам это нужно как вы говорите "для работы и постоянно". До свидания.

[soulthiefer]

Aent простите пожалуйста видимо и правда плохо объяснил !
смысм программы в следующем :
дано 4 столбца в каждом минимум 30 000 строк.каждая ячейка содержит ЧИСЛО которое состоит из 10 знаков ( 1234567890 1345678902 и т д )
нужно сравнить между собой все эти столбцы и выдать результат в виде таблицы с 4 столбцами !
действие макроса такое :
берется значение 1-й ячейки 1-го столбца ( 1;1) например 1234567890 и сравнивается со всеми значениями в столбцах 2 , 3 и 4 первой таблицы
если происходит совпадение например число 1234567890 есть в 3 столбце первой табл тогда 1234567890 записывается в ту же самую ячейку из которой мы его взяли для поиска ( 1;1)второй таблицы (предварительно проверив есть ли такое значение в этом столбце второй табл :если есть - не пишем идем дальше искать( берем значение из ячейки 1;2 первой таблицы); если нет - пишем) и в третью ячейку ( т к нашли совпадение в третьем столбце первой таблицы) (1;3) второй таблице записываем 1234567890.еслиб совпало во втором столбце тогда во второй таблице записали бы число 1234567890 в ячейку(1;2)!если совпадение было по нескольким столбцам то во второй таблице были б заполнены ячейки в соответствующих столбцах!
далее берется вторая ячейка первого столбца и ищется во 2 3 4 столбцах первой табл ........ потом первая чейка второго столбца и ищется в 1 3 4 столбцах первой таблице и т д и т д

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

почему то не смог сюда прикрепить файл примера потовы выложил на майл http://files.mail.ru/RUHTMP

[Aent]

Ну если я вас правильно понял ...

Код: Выделить всё

Public Sub СЧЁТЧИК_СОВПАДЕНИЙ()
' предполагается расположение исходного массива данных в ячейках
' A1 : Dn активого листа и результата в столбцах F : I
    Dim n As Long        'номер последней строки данных
    Dim k As Long        'номер очередной формируемой строки отчёта о совпадениях
    Dim i As Long
    Dim j As Long
    Dim m As Long        'номер формируемой колонки отчёта о совпадениях
    Dim v As Double      'тестируемое число
    'В предположении что под массивом данных ничего нет
    n = Cells(Cells.Rows.Count, 1).End(xlUp).Row 'последняя строка исходной таблицы
    k = 1
    Application.ScreenUpdating = False
    For j = 1 To 4
         For i = 1 To n
              v = Cells(i, j).Value
              If Application.WorksheetFunction.CountIf([F:I], v) = 0 Then
                  For m = 1 To 4
                       If m <> j Then
                            If Application.WorksheetFunction.CountIf(Cells(1, m).Resize(n, 1), v) > 0 Then
                                  Cells(k, 5 + m) = v
                            End If
                       Else
                            Cells(k, 5 + m) = v
                       End If
                   Next m
                   If Application.WorksheetFunction.Sum(Range(Cells(k, 6), Cells(k, 9))) = v Then
                        Range(Cells(k, 6), Cells(k, 9)).ClearContents
                   Else
                        k = k + 1
                   End If
              End If
         Next i
   Next j
   Application.ScreenUpdating = True
End Sub