[azbest]

Я тоже его поробовал раскопировать. В конце получил вопрос - В буфере имеется большой список данных - сохранить его? Это при одном единственном столбце в Листе1. А если столбцов будет к примеру - 32 с разными данными? Попробуйте поэкспериментировать - Незабуксует программа?
Можно попробовать ещё вот так:

Код:

Sheets(1).select
s=Cells(1,1).currentregion.rows.count
for i=1 to s-1
sheets(1).select
Cells(i,1).select
FF=activecell.value
L=Left(Cells(i,1),1)
Sheets(L).select
Selection.insert Shift:=xldown
Activeceell.value=FF
next i
msgbox("Конец")

[Pliomera]

Option Base 1 '... Dim RussianLetters(33) As String RussianLetters(1) = "Аа" RussianLetters(2) = "Бб" RussianLetters(3) = "Вв" RussianLetters(4) = "Гг" RussianLetters(5) = "Дд" RussianLetters(6) = "Ее" RussianLetters(7) = "Ёё" RussianLetters(8) = "Жж" RussianLetters(9) = "Зз" RussianLetters(10) = "Ии" RussianLetters(11) = "Йй" RussianLetters(12) = "Кк" RussianLetters(13) = "Лл" RussianLetters(14) = "Мм" RussianLetters(15) = "Нн" RussianLetters(16) = "Оо" RussianLetters(17) = "Пп" RussianLetters(18) = "Рр" RussianLetters(19) = "Сс" RussianLetters(20) = "Тт" RussianLetters(21) = "Уу" RussianLetters(22) = "Фф" RussianLetters(23) = "Хх" RussianLetters(24) = "Цц" RussianLetters(25) = "Чч" RussianLetters(26) = "Шш" RussianLetters(27) = "Щщ" RussianLetters(28) = "Ъъ" RussianLetters(29) = "Ыы" RussianLetters(30) = "Ьь" RussianLetters(31) = "Ээ" RussianLetters(32) = "Юю" RussianLetters(33) = "Яя" For i = 1 To 33 Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = RussianLetters(i) Next i »

Вместо всего выше написанного, достаточно просто:

Код:

For i = 1 To 32
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Chr$(i + 191) & Chr$(i + 223)
Next i

[Admiral]

Pliomera, да конечно, но то наочние для новичков, которые ещё не знают про Chr$, а про массивы уже знают.

[Aizec]

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

Код:

 i = 1
    While Workbooks(file2).Worksheets("List").Cells(i, 1).Value <> ""
          current = Workbooks(file2).Worksheets("List").Cells(i, 1).Value
          j = 1
          flag = False
          Do While Workbooks(file1).Worksheets("List").Cells(j, 1).Value <> ""
                   If Workbooks(file1).Worksheets("List").Cells(j, 1).Value = current Then
                      flag = True
                      Exit Do
                   End If
                   j = j + 1
           Loop
          If flag = True Then
             Workbooks(file2).Worksheets("List").Cells(i, 2).Value = Workbooks(file1).Worksheets("List").Cells(j, 2).Value
             Workbooks(file2).Worksheets("List").Cells(i, 2).Interior.Color = RGB(0, 255, 0)             
          End If
          i = i + 1          
    Wend

[Strange_V]

Aizec, ВПР?

[Aizec]

ВПР? »

Что это такое?

[Strange_V]

ВПР - это функция, точно не помню работает ли она с разными книгами, но думаю да.

[Aizec]

Strange_V Спасибо, но это не подходит - я ведь не знаю содержимого ячеек.

[azbest]

Если Вы не знаете содержимое ячеек, значит Вы не можете знать сколько раз может совпасть идентификатор из первого файла с перебираемыми идентификаторами во втором файле (если только идентификатор - это не числа по порядку). А у вас как только они совпадают (i,1).value = (j,1).value - происхлдит выход из цикла переборки и берётся следующий идентификатор из первого файла (i,1).
Кроме того у вас каждый раз при "exit Do" - рушится цикл переборки хотя текущий его счётчик "j" запоминается и далее уже при i = i+1 - снова создается новый Do ...Loop c запомненным "j", плюс ещё каждый раз происходит сравнение с "непустым" значением - проверка на конец списка.
Попробуйте вот так:

Код:

S1=Workbooks(file2).Worksheets("List").Cells(1, 1).currentregion.rows.count
S2=Workbooks(file1).Worksheets("List").Cells(1, 1).currentregion.rows.count
for x=1 to S1
idn1=Workbooks(file1).Worksheets("List").Cells(x, 1).value
      for y=1 to S2
        idn2=Workbooks(file2).Worksheets("List").Cells(y, 1).
            if idn1=idn2 then
            zn1=Workbooks(file1).Worksheets("List").Cells(x, 2).value
            Workbooks(file2).Worksheets("List").Cells(y, 2).value=zn1
            Workbooks(file2).Worksheets("List").Cells(i, 2).Interior.Color = RGB(0, 255, 0
            end if
            next y
next x

[Aizec]

azbest Спасибо.
И у меня еще один вопрос возник: как импортировать в Excel не весь текстовый файл, а только текст заключенный в кавычки ""? Потом его еще надо будет после перевода обратно вставить.