PDA

Просмотр полной версии : VB в Excele. ХЕЛП.


ТП "Гибкое решение" Билайн
ТП "Гибкое решение" Билайн
Тарифы: МТС, Билайн, МегаФон
Выгодные непубличные тарифы МТС, Билайн, МегаФон, Безлимитный интернет ✅
Neyron81
27-10-2004, 09:35
Задача вкратце такова:
дан список на одном листе
надо автоматически перенести на другой и автоматически упорядочить по определенному параметру(один из столбцов)

Нужны специфические функции необходимые для этого.
ХЕЛП.

Капитан Тру-ля-ляй
27-10-2004, 09:59
БШДПЮРН ХГ ЦНРНБНЦН ПЮАНВЕЦН ОПНЕЙРХЙЮ, ПЮГАХПЮИЯЪ ЯЮЛ. ГЮ НОРХЛХГЮЖХЕИ МЕ ЦМЮКЯЪ, КЮАЮК МЮ ЯЙНПСЧ ПСЙС

ЯЮЛ ЙНД:
nLastDataRow=20
Copy2SortList nLastDataRow
' ЯНПРХПСЕЛ ОН НОЕПЮЖХХ
Prepare4Sort "O"

Worksheets("сДЮКХРЭ").Range("A1:Y" & nLastDataRow - 18).Sort _
Key1:=Worksheets("сДЮКХРЭ").Range("U1:U1")

' БШГШБЮЕЛШЕ ОПНЖЕДСПЙХ
'ЙНОХПНБЮМХЕ ЯРПНЙ МЮ БПЕЛЕММШИ КХЯР
Private Sub Copy2SortList(nLastDataRow As Integer)
Rows("1:" & nLastDataRow).Select
Selection.Copy
Sheets(Sheets.Count).Select
Sheets.Add
Selection.Insert Shift:=xlDown ' or ActiveSheet.Paste
Sheets(Sheets.Count - 1).Name = "сДЮКХРЭ"
Application.CutCopyMode = False
End Sub

' ОНДЦНРНБЙЮ Й ЯНПРХПНБЙЕ. лМЕ МСФМН АШКН ЯНПРХПНБЮРЭ ОН ЛМНЦХЛ ЯРНКАЖЮЛ Х Б ПЮГМНЛ ОНПЪДЙЕ, ОНЩРНЛС ОПХЬКНЯЭ ТНПЛХПНБЮРЭ ЕЫЕ НДХМ ЯРНКАЕЖ(╧21) Х ОН МЕЛС ЯНПРХПНБЮРЭ
Private Sub Prepare4Sort(CodeSort As String) 'O=oper,9=Cash,C=Check
Dim CurrentRowOp As Integer
CurrentRowOp = 1
With Worksheets("сДЮКХРЭ") 'ДНАЮБКЪЕЛ ЙНКНМЙХ ДКЪ ЯНПРХПНБЙХ ОН 5 ЯРНКАЖЮЛ
Do
If .Cells(CurrentRowOp, 1) = Empty Then
Exit Do
End If
.Cells(CurrentRowOp, 1).NumberFormat = "9"
'ГЮОНКМЪЕЛ ЯРНКАЕЖ U ДЮММШЛХ ДКЪ ЯНПРХПНБЙХ
.Cells(CurrentRowOp, 21).NumberFormat = "@"

.Cells(CurrentRowOp, 21).Value = Format(IIf(CodeSort = "9", 0, IIf(.Cells(CurrentRowOp, 3).Value = Empty, 0, .Cells(CurrentRowOp, 3).Value)), "000") & _
Format(IIf(CodeSort = "C", 0, IIf(.Cells(CurrentRowOp, 5).Value = Empty, 0, .Cells(CurrentRowOp, 5).Value)), "000") & _
Format(IIf(CodeSort = "C", 0, IIf(.Cells(CurrentRowOp, 7).Value = Empty, 0, .Cells(CurrentRowOp, 7).Value)), "000") & _
Format(IIf(CodeSort = "9", 0, IIf(.Cells(CurrentRowOp, 11).Value = Empty, 0, .Cells(CurrentRowOp, 11).Value)), "000") & _
Format(IIf(CodeSort = "C", 0, .Cells(CurrentRowOp, 19).Value), "000")
CurrentRowOp = CurrentRowOp + 1
Loop

End With
End Sub

Neyron81
27-10-2004, 10:54
сам код:
nLastDataRow
Copy2SortList nLastDataRow
' сортируем по операции
Prepare4Sort "O"

Worksheets("Удалить").Range("A1:Y" & nLastDataRow - 18).Sort _
Key1:=Worksheets("Удалить").Range("U1:U1")

' вызываемые процедурки
'копирование строк на временный лист
Private Sub Copy2SortList(nLastDataRow As Integer)
Rows("1:" & nLastDataRow).Select
Selection.Copy
Sheets(Sheets.Count).Select
Sheets.Add
Selection.Insert Shift:=xlDown ' or ActiveSheet.Paste
Sheets(Sheets.Count - 1).Name = "Удалить"
Application.CutCopyMode = False
End Sub

' подготовка к сортировке. Мне нужно было сортировать по многим столбцам и в разном порядке, поэтому пришлось формировать еще один столбец(g21) и по нему сортировать
Private Sub Prepare4Sort(CodeSort As String) 'O=oper,9лsh,C=Check
Dim CurrentRowOp As Integer
CurrentRowOp = 1
With Worksheets("Удалить") 'добавляем колонки для сортировки по 5 столбцам
Do
If .Cells(CurrentRowOp, 1) = Empty Then
Exit Do
End If
.Cells(CurrentRowOp, 1).NumberFormat = "9"
'заполняем столбец U данными для сортировки
.Cells(CurrentRowOp, 21).NumberFormat = "@"

.Cells(CurrentRowOp, 21).Value = Format(IIf(CodeSort = "9", 0, IIf(.Cells(CurrentRowOp, 3).Value = Empty, 0, .Cells(CurrentRowOp, 3).Value)), "000") & _
Format(IIf(CodeSort = "C", 0, IIf(.Cells(CurrentRowOp, 5).Value = Empty, 0, .Cells(CurrentRowOp, 5).Value)), "000") & _
Format(IIf(CodeSort = "C", 0, IIf(.Cells(CurrentRowOp, 7).Value = Empty, 0, .Cells(CurrentRowOp, 7).Value)), "000") & _
Format(IIf(CodeSort = "9", 0, IIf(.Cells(CurrentRowOp, 11).Value = Empty, 0, .Cells(CurrentRowOp, 11).Value)), "000") & _
Format(IIf(CodeSort = "C", 0, .Cells(CurrentRowOp, 19).Value), "000")
CurrentRowOp = CurrentRowOp + 1
Loop

End With
End S


нет хуже разбираться в чужом проекте
но все равно спасибо.

мне нужны фукции
1)Копирования строки с одного листа на другой(копи(номер строки,лист1,номер строки куда,лист2))
2)условие нахождение в ячейке какого либо значения.(УНЕ(строка, столбец):boolean)
упорядычивание по определенному признаку
функупр(лист,столбtц,значение вверх или вниз упорядычивать)
должна быть стандартная, если нету
придеться методом пузырька.

прога в моем понимании будет выглядеть так:

i=1.
While УНЕ(i,"a")
копи(i,лист1,i,лист2)
wend

функупр(лист2, ну скажем A, вверх)


есть тут эти функции?

Neyron81
27-10-2004, 11:50
очень нужно.

nekto
27-10-2004, 18:53
Номер строки с которой копировать и номер стр. куда копировать изменяется?

Junior
27-10-2004, 19:04
Может поможет..??
Макрос - копирует с текущего листа столбец B, на лист 2, и сортирует его по возрастанию

Sub Макрос()
'
' ......
'
Columns("B:B").Select
Selection.Copy
Sheets("Лист2").Select
Columns("B:B").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub