vba를 사용하여 Excel에서 그룹 값의 최대 값을 찾는 방법은 무엇입니까?

Question

나는 다음과 같이 다음과 같은 테이블이 :

Name Storey Location Value1 Value2 Value3 
B1 6F  0  11  22  33 
B1 6F  1  21  32  10 
B1 6F  2  10  21  35 
B1 5F  0  12  21  34 
B1 5F  1  23  33  9 
B1 5F  2  12  20  36 
B2 6F  1.1  8  20  21 
... 

내가 얻고 싶은 것은 각각의 이름 (B1, B2, B3에 대한 값 1, 값 2, 값 3의 최대 값을 찾는 것입니다 .. ..) 다른 이야기의 같은 위치에, 그리고 새 테이블을 생성합니다. 아래와 같이 :

Name Location Value1 Value2 Value3 
B1 0  12  22  34 
B1 1  23  33  10 
B1 2  12  21  36 
B2 ... 

누구나이 작업을 수행하는 방법을 알고 VBA 매크로?

감사합니다.

Answer 1

이 식을 시도 가정 촬영지 열에 수식하고 Ctrl + 시프트

{=MAX(IF($C$2:$C$8=$C2,D$2:D$8,FALSE))} 

유형 D8 +

Answer 2

가 붙여 입력 D2 이리저리 C8 가치 1 개 칼럼 C2 내지 아래 언급 모듈의 VBA 코드. 변수를 source_rng (헤더를 포함한 원시 데이터가있는 범위) 및 target_rng (결과를 붙여 넣을 셀 참조)로 수정하면됩니다.

예를 들어 원시 데이터가 범위 H3 : m10에있는 경우 source_rng = 인 경우. 범위 ("H3 : M10") -이 범위는 헤더를 포함해야한다

을 이제 셀 "O3"결과 다음 target_rng = .Range 붙여 넣을 ("03")를

지금. 아래에 언급 된 코드를 모듈에 붙여 넣으십시오.

Sub t() 

Dim myarr() 

Dim myarr_max() 

Dim source_rng As Range 

Dim target_rng As Range 

With ActiveSheet 

    Set source_rng = .Range("h3:m10") 
    Set target_rng = .Range("o3") 
    target_rng.CurrentRegion.Clear 
    source_rng.Copy 
    target_rng.PasteSpecial (xlPasteAll) 
    Selection.Columns(2).Delete shift:=xlToLeft 
    .Range(Selection.Cells(2, 3), Selection.Cells(Selection.Rows.Count, Selection.Columns.Count)).ClearContents 
    Selection.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes 

    For k = 1 To 3 
       For Each target_cell In Selection.Columns(1).Cells 
        i = i + 1 
        If i <> 1 And target_cell <> "" Then 
         target_count = target_count + 1 
         For Each source_cell In source_rng.Columns(1).Cells 
          j = j + 1 
          If j <> 1 Then 
           If target_cell.Value & "_" & target_cell.Offset(0, 1) = source_cell.Value & "_" & source_cell.Offset(0, 2) Then 
            Counter = Counter + 1 
            ReDim Preserve myarr(Counter - 1) 
            myarr(Counter - 1) = source_cell.Offset(0, k + 2) 
           End If 
          End If 
         Next source_cell 

          ReDim Preserve myarr_max(target_count - 1) 
          myarr_max(target_count - 1) = WorksheetFunction.Max(myarr) 
          Erase myarr 
          Counter = 0 
        End If 

       Next target_cell 
      .Range(.Cells(Selection.Rows(2).Row, Selection.Columns(k + 2).Column), .Cells(Selection.Rows(2).Row + UBound(myarr_max), Selection.Columns(k + 2).Column)) = WorksheetFunction.Transpose(myarr_max) 
      Erase myarr_max 
      target_count = 0 
      i = 0 
      j = 0 

    Next k 

End With 

End Sub