|
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007):
* 아래줄에 질문을 작성하세요 >>
안녕하세요,
첨부파일에서 자료탭에 있는 정보를 기본으로 사무직 탭에서 노란색 부분 처럼 정보를 가져오면 좋겠습니다.
-가능하다면 가져오는 정보가 금액 오름차순으로 가져오면 좋겠습니다.
-가능하다면 상한(B3), 하한(B4)이 수시로 변하는데, 상한 이상인 금액은 빨간색, 하한 이하인 금액은 파란색으로 오면 좋겠습니다.
대단히 감사합니다.
==============[피닉스님 글에 대한 답변입니다]==============
첨부화일 참고하세요...
Sub getData()
Dim wst As Worksheet
Dim rData As Range
Dim rStaff As Range, rX As Range
Dim sGuBun As String
Dim rTg As Range, lRow As Long, lColor As Long
Dim lMoney As LongLong, lUp As LongLong, lDn As LongLong
Dim rFind As Range, sAddr As String
Call SpeedOn
Set rData = Worksheets("자료").Range("a3:AD54") ' B-성명, E-직위, F-부서, O-구분, AD-연봉
Set wst = ActiveSheet
sGuBun = wst.Cells(1)
sGuBun = wst.Name
' 기존 자료초기화
wst.Range("A6:R100").ClearContents
Set rStaff = wst.Rows(2).SpecialCells(2) ' xlCellTypeConstants
For Each rX In rStaff.Cells
If rX <> "" Then
lUp = rX.Cells(2, 2)
lDn = rX.Cells(3, 2)
Set rTg = rX.Offset(4)
lRow = 0
Set rFind = rData.Columns("O").Find(What:=sGuBun, Lookat:=xlWhole)
If Not rFind Is Nothing Then
sAddr = rFind.Address
Do
With rFind.EntireRow
If .Cells(1, "E") = rX Then
lRow = lRow + 1
rTg.Cells(lRow, 1) = .Cells(1, "B")
rTg.Cells(lRow, 2) = .Cells(1, "F")
lMoney = .Cells(1, "AD")
rTg.Cells(lRow, 3).Value = Format(lMoney, "#,##0")
If lMoney > lUp Then
lColor = RGB(255, 0, 0)
ElseIf lMoney < lDn Then
lColor = RGB(0, 0, 255)
Else
lColor = RGB(0, 0, 0)
End If
rTg.Cells(lRow, 1).Resize(1, 3).Font.Color = lColor
End If
End With
Set rFind = rData.Columns("O").FindNext(rFind)
Loop While Not rFind Is Nothing And rFind.Address <> sAddr
If lRow > 0 Then
With rTg.Resize(lRow, 3)
.Sort Key1:=.Cells(1, 3), Header:=xlNo
End With
End If
End If
End If
Next
Call SpeedOn(False)
End Sub
|
|