транспонировать колонки в строки

[tevadim]

Буду благодарен сброшу на мыло

[IgorGO]

запакуйте архиватором и крепите к сообщению.

[tevadim]

Что я и делаю любой формат дает ошибку :
Primer.rar :
Загрузка файла прошла неудачно.
Загрузить файл с вашего компьютера
Размер файла 40 kb
Такие вопросы вообще кажется странно обсуждать ...какой-то бзик на сайте

[Hugo121]

Загрузите на любой файлообменник.

[Hugo121]

Ну-ка, проверю, как крепится...

Без обработки ошибок - если ширины листа не хватит - я не виноват.
Всё равно не известно, что в таком случае делать

P.S. Переделывать под другой пример не буду.
И не понятно, с чего это Name 2 ----------------- должно было быть?

[IgorGO]

извините, огромное подозрение, что Вы что-то делаете не так. если бы файлы не цеплялись к сообщениям - форум можно было бы давно закрывать. А наш форум очень популярен. задайте любой вопрос по ексель, посмотрите куда Вас приведет ответ Гугля.
Вы не попали под особые правила, что-то Вы делаете не так.
Выдохните, соберитесь. архив здесь легко прикрепить.

[tevadim]

Огромное спасибо Всем и особенно Hugo121 получилось то что надо !Очень приятно что ЕСТЬ ОТЗЫВЧИВЫЕ ЛЮДИ !По поводу файла я может конечно и чайник по вопросам програмирования но не настолько чтоб не уметь загружать файлы просто попробую через FTP загрузить . Может проблема в том что я сейчас захожу не c Росийского İP

[Hugo121]

Так и я не с российского...
Кстати, насчёт имен без данных - если отключить две строки кода (одну проверку), то такие имена будут заносится в словарь, и будет вроде Name 2 -----------------

Sub Otbor()
    Dim a(), oDict As Object, i As Long, temp$, test$, kk

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False

        a = Range([A1], Range("B" & Rows.Count).End(xlUp)).Value

        Set oDict = CreateObject("Scripting.Dictionary")
        oDict.CompareMode = vbTextCompare

        For i = 1 To UBound(a)

            test = Application.Trim(a(i, 1))
            If Len(test) Then temp = test

'            If Len(Application.Trim(a(i, 2))) Then
                If Not oDict.Exists(temp) Then
                    ReDim b(0)
                    b(0) = a(i, 2)
                    oDict.Add temp, b
                Else
                    b = oDict.Item(temp)
                    ReDim Preserve b(UBound(b) + 1)
                    b(UBound(b)) = a(i, 2)
                    oDict.Item(temp) = b
                End If
'            End If

        Next


        With Workbooks.Add.Sheets(1)
            i = 0
            For Each kk In oDict.keys
                i = i + 1
                b = oDict.Item(kk)
                Cells(i, 1) = kk
                Cells(i, 2).Resize(, UBound(b) + 1) = b
            Next
            .Cells.EntireColumn.AutoFit
        End With


        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

[tevadim]

OK Спасибо ! Все работает супер .

[tevadim]

Сообщение от tevadim

A КОЛОНКА НАИМЕНОВАНИЯ В КОЛОНКА ЦИФР

(А ) столюцы ( В )

NAME2 63
-------- 78
-------- 55
-------- 89
NAME3 78
---------78
---------64
-----------
NAME20 67
---------86
---------84
---------90
---------112
---------71

Vot link:
http://gamidi.net/files/Primer.rar