|
こんばんは
最初から計算式を複数データに対応しておけば良かったですね。
Sub test2()
Dim i As Long
Dim r As Range
Const j As Long = 17
i = Cells(Rows.Count, 1).End(xlUp).Row
Set r = Range("A11", Cells(i, j))
With r.Offset(, j).Columns(1)
.Formula = "=IF(COUNTIF(A11:A$" & i & ",A11)=COUNTIF(A$11:A$" & i & ",A11)," & _
"MAX(OFFSET(A10:A$11,0," & j & "))+COUNTIF(A$11:A$" & i & ",A11)," & _
"OFFSET(A$11,MATCH(A11,A11:A$11,0)-1," & j & ")-COUNTIF(A$11:A10,A11))"
.Cells(1, 1).Formula = "=COUNTIF(A11:A$" & i & ",A11)"
.Value = .Value
r.Resize(, r.Columns.Count + 1).Sort _
key1:=r(1, 1).Offset(, j), Order1:=xlAscending
.ClearContents
End With
End Sub
こんな感じで。
▼CAFE777 さん:
>こんにちは^^
>以前に質問をし、ウッシさんから回答をいただき解決しました。
>その際に「同じコードは最大2つまで」の条件がありました。
>この条件では全く問題なくご提示いただきましたコードでばっちりでした。
>が、たとえば、イレギュラーで同じコード(A列)が、3つや4つになった場合にも
>下記の例でいえば、りんご3がりんごの中で1番上にいくようなことはできますか?
>色々コードを修正したりしたんですが、八方ふさがりです。
>どうかご教授願います。
>
>
>例)
>A列・・・・・Q列
>りんご1
>ばなな1
>なし1
>なし2
>ばなな2
>りんご2
>りんご3
>
>※希望結果
>例)
>A列・・・・・Q列
>りんご3
>りんご2
>りんご1
>ばなな2
>ばなな1
>なし2
>なし1
>
>
>Sub test1()
> Dim i As Long
> Dim r As Range
> Const j As Long = 17
> i = Cells(Rows.Count, 1).End(xlUp).Row
> Set r = Range("A11", Cells(i, j))
> With r.Offset(, j).Columns(1)
> Application.Calculation = xlCalculationManual
> .Formula = "=IF(COUNTIF(A11:A$" & i & ",A11)=2," & _
> "MAX(OFFSET(A10:A$11,0," & j & "))+2," & _
> "OFFSET(A$11,MATCH(A11,A10:A$11,0)-1," & j & ")-1)"
> .Cells(1, 1).Formula = "=COUNTIF(A11:A$" & i & ",A11)"
> Application.Calculation = xlCalculationAutomatic
> .Value = .Value
> r.Resize(, r.Columns.Count + 1).Sort _
> key1:=r(1, 1).Offset(, j), Order1:=xlAscending
> .ClearContents
> End With
>End Sub
|
|