Вывод переменной в ячейку

[Chaoslord]

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

[kalbasiatka]

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

чтобы по введению макроса

Куда его ввести надо?
Если фамилии одинаковые, а цифры разные, то какие брать в 4-ю колонку?
Есть такая шайтан-функция =ВПР()

[Chaoslord]

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

Куда его ввести надо?
Если фамилии одинаковые, а цифры разные, то какие брать в 4-ю колонку?
Есть такая шайтан-функция =ВПР()

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

[Hugo121]

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

как надо выводить значение переменной в ячейку (в макросе vba)

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

[C1]=x

Тут на форуме практически в каждом макросе есть вывод в ячейку - не пробовали посмотреть? Да и хелп по VBA тоже есть смысл почитать.
Вы бы пример в файле показали, и рассказали, сколько чего прогнозируете.
Одно дело - если всего 100 фамилий и максимум по 10 цифр на каждую. Другое дело - 10000 фамилий, и количество цифр может быть тоже по несколько тысяч (2007 позволяет столько в строку выгрузить).

Ладно, вот под любой случай:

Option Explicit

Sub tt()
    Dim a(), t$, i&, ii&, iii&, mx&, k, kk

    a = [a1].CurrentRegion.Columns(1).Resize(, 2).Value
    With CreateObject("scripting.dictionary"): .comparemode = 1
        For i = 1 To UBound(a)
            t = a(i, 1)
            If Not .exists(t) Then .Add t, New Collection
            .Item(t).Add a(i, 2): If mx < .Item(t).Count Then mx = .Item(t).Count
        Next
        ReDim b(1 To .Count, 1 To mx + 1)
        For Each k In .keys
            ii = ii + 1: iii = 1
            b(ii, 1) = k
            For Each kk In .Item(k)
                iii = iii + 1
                b(ii, iii) = kk
            Next
        Next
    End With

    [c1].Resize(UBound(b), UBound(b, 2)) = b
End Sub

[Watcher_1]

Или такой вариант

Sub m()
    Dim myF As Range
    i = 0
    myE = ActiveSheet.UsedRange.Rows.Count + 1
    Columns("D:E").ClearContents
    Do
        i = i + 1
        DoEvents
        If i = myE Then Exit Do
        Set myF = Range("D1:D" & myE).Find(Range("A" & i), , , xlWhole)
        If Not myF Is Nothing Then
            Cells(myF.Row, myF.End(xlToRight).Column + 1) = Range("B" & i)
        Else
            myE2 = Range("D" & ActiveSheet.Rows.Count).End(xlUp).Row
            If Range("D" & myE2) <> "" Then myE2 = myE2 + 1
            Range("D" & myE2) = Range("A" & i)
            Range("E" & myE2) = Range("B" & i)
        End If
    Loop
End Sub

[Chaoslord]

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

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

[C1]=x

Тут на форуме практически в каждом макросе есть вывод в ячейку - не пробовали посмотреть? Да и хелп по VBA тоже есть смысл почитать.
Вы бы пример в файле показали, и рассказали, сколько чего прогнозируете.
Одно дело - если всего 100 фамилий и максимум по 10 цифр на каждую. Другое дело - 10000 фамилий, и количество цифр может быть тоже по несколько тысяч (2007 позволяет столько в строку выгрузить).

Ладно, вот под любой случай:

Option Explicit

Sub tt()
    Dim a(), t$, i&, ii&, iii&, mx&, k, kk

    a = [a1].CurrentRegion.Columns(1).Resize(, 2).Value
    With CreateObject("scripting.dictionary"): .comparemode = 1
        For i = 1 To UBound(a)
            t = a(i, 1)
            If Not .exists(t) Then .Add t, New Collection
            .Item(t).Add a(i, 2): If mx < .Item(t).Count Then mx = .Item(t).Count
        Next
        ReDim b(1 To .Count, 1 To mx + 1)
        For Each k In .keys
            ii = ii + 1: iii = 1
            b(ii, 1) = k
            For Each kk In .Item(k)
                iii = iii + 1
                b(ii, iii) = kk
            Next
        Next
    End With

    [c1].Resize(UBound(b), UBound(b, 2)) = b
End Sub

Благодарю!

[Chaoslord]

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

Или такой вариант

Sub m()
    Dim myF As Range
    i = 0
    myE = ActiveSheet.UsedRange.Rows.Count + 1
    Columns("D:E").ClearContents
    Do
        i = i + 1
        DoEvents
        If i = myE Then Exit Do
        Set myF = Range("D1:D" & myE).Find(Range("A" & i), , , xlWhole)
        If Not myF Is Nothing Then
            Cells(myF.Row, myF.End(xlToRight).Column + 1) = Range("B" & i)
        Else
            myE2 = Range("D" & ActiveSheet.Rows.Count).End(xlUp).Row
            If Range("D" & myE2) <> "" Then myE2 = myE2 + 1
            Range("D" & myE2) = Range("A" & i)
            Range("E" & myE2) = Range("B" & i)
        End If
    Loop
End Sub

Благодарю)