Господа, посмотрите пожалуйста и подскажите, что я делаю не так. На EXCEL листе набиты Ф.И.О. около 900 записей, в каждой строке в таком порядке:
Борисов
Владимир
Викторович
Петров
Петр
Петрович
и т.д. Надо их переписать на другой лист так, чтобы Ф.И.О. стояли в разных столбцах:
Борисов Владимир Викторович
Петров Петр Петрович
Private Sub CommandButton2_Click()
Worksheets("Лист1").Activate
NumStr = 4
For i = 1 To 900
s = Worksheets("Лист1").Cells(NumStr, 1) ' вся строка
If s = "" Then Exit For
f = Left(s, 15)
Worksheets("Лист 2").Cells(NumStr, 1) = f
NumStr = NumStr + 1
i = Left(s, 15)
Worksheets("Лист2").Cells(NumStr, 2) = i
NumStr = NumStr + 1
Next
End Sub
Спасибо Вам большое,все работает как нам надо.17.05.05 15:24 Автор: sls Статус: Незарегистрированный пользователь
> Господа, посмотрите пожалуйста и подскажите, что я делаю не > так. На EXCEL листе набиты Ф.И.О. около 900 записей, в > каждой строке в таком порядке: > Борисов > Владимир > Викторович > Петров > Петр > Петрович > и т.д. Надо их переписать на другой лист так, > чтобы Ф.И.О. стояли в разных столбцах: > Борисов Владимир Викторович > Петров Петр > Петрович > Private Sub CommandButton2_Click() > Worksheets("Лист1").Activate > NumStr = 4 > For i = 1 To 900 > s = Worksheets("Лист1").Cells(NumStr, 1) ' > вся строка > If s = "" Then Exit For > f = Left(s, 15) > Worksheets("Лист 2").Cells(NumStr, 1) = f > NumStr = NumStr + 1 > i = Left(s, 15) > Worksheets("Лист2").Cells(NumStr, 2) = i > NumStr = NumStr + 1 > Next > End Sub
Не мудровствая лукаво..... :)))
Private Sub CommandButton1_Click()
y = 1
t = 0
i = 0
While ActiveSheet.Cells(y, 1).Value <> ""
RemoveCell = ActiveSheet.Cells(y, 1).Value
Worksheets("Лист2").Cells(y - t - i, 1 + t).Value = RemoveCell
y = y + 1
t = t + 1
If t = 3 Then
t = 0
i = i + 2
End If
Wend
End Sub
Извините, но у меня ничего не копируется17.05.05 13:42 Автор: sls Статус: Незарегистрированный пользователь