Создание отдельного Excel с использованием Macro - PullRequest
0 голосов
/ 06 ноября 2010

У меня есть Excel с одной колонкой, в которой есть информация о тендере. Каждая ячейка будет иметь значение типа

Колонка: Nokia ([Mode1.Number], OLD)

Колонка: Motorola ([Mode1.Number], OLD)

Колонка: Motorola ([Mode2.Number], NEW)

Колонка: Motorola ([Mode3.Number], OLD)

Колонка: Samsung ([Mode2.Number], NEW)

Мне нужно создать 2 Excel из этого. Нужно иметь всю информацию о СТАРЫХ, а второе превосходство должно иметь всю информацию о НОВЫХ.

Так что мой вывод Excel должен содержать

Первый Excel

Nokia ([Model1.Number])

Motorola ([Mode1.Number])

Motorola ([Mode3.Number])

Второй Excel

Motorola ([Mode2.Number])

Samsung ([Mode2.Number])

Пожалуйста, помогите мне .. Заранее спасибо ..

Ответы [ 2 ]

0 голосов
/ 05 января 2011
Sub SplitOldNew()
Dim InRange As Range, OldRange As Range, NewRange As Range
Dim Idx As Integer

    Set InRange = Selection                ' select all cells to be split
    Set OldRange = Worksheets("OLD").[A1]  ' choose appropriate target entry points
    Set NewRange = Worksheets("NEW").[A1]  ' ...
    Idx = 1                                ' loop counter

    Do While InRange(Idx, 1) <> ""
        If InStr(1, InRange(Idx, 1), "OLD") <> 0 Then
            DBInsert OldRange, InRange(Idx, 1)
        Else
            DBInsert NewRange, InRange(Idx, 1)
        End If
        Idx = Idx + 1
    Loop
End Sub

Sub DBInsert(intoRange As Range, Arg As String)
Dim Idx As Integer

    Idx = 1                                ' loop counter
    Do While intoRange(Idx, 1) <> ""       ' find first blank row
        Idx = Idx + 1
    Loop

    intoRange(Idx, 1) = Arg                ' write out
End Sub
0 голосов
/ 31 декабря 2010

Выделите ячейки, содержащие данные, которые вы хотите скопировать, а затем выполните этот код

sub copystuff
dim r as range
dim tn as range
im to as range
dim wsNewTarget as worksheet
dim wsOldTarget as worksheet
dim wsSource as worksheet
set wsSource = activesheet
set wsNewtarget = activeworkbook.worksheets.add
set wsoldtarget = activeworkbook.worksheets.add
set tn = wsnewtarget.range("a1")
set to =wsoldtarget.range("a1")
for each r in wssource.selection
    if imstr(r,"NEW")>0 then
          tn=r
           set tn = tn.offset(1,0)
    else
         to=r
           set to = to.offset(1,0)

     end if
next r
end sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...