Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

34952 / 76734

←次へ　｜　前へ→


	【46985】Re:条件つき列の並べ替え　[46222]関連

かみちゃん - 07/2/24(土) 17:37 -


	引用なし

	パスワード

こんにちは。かみちゃん　です。

>＊条件・・・常にＣ列における最新の日付けの行を選択。下記の例では2007/2/3が　該当する。つまり、７行から15行が該当しＡ7～Ｏ15を並べ替えたい。

ｈｔｔｐ://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=46222;id=excel
のスレッドの関連かと思いますが、この中の[46229]のichinoseさんのコードを
少し改造するだけでできます。

具体的には、以下のような感じになります。
Sub main2()
　Dim rw2 As Long
　Dim rw1 As Long
　Dim newdate As Date
　
　With Worksheets("Sheet1")
　　rw2 = .Cells(.Rows.Count, "c").End(xlUp).Row
　　newdate = .Range("c" & rw2).Value
　　For rw1 = rw2 - 1 To 1 Step -1
　　　If .Range("c" & rw1).Value <> newdate Then Exit For
　　Next rw1
'　　.Range(.Cells(rw1 + 1, 1), .Cells(rw2, 1)).Copy
'　　Worksheets("sheet2").Range("v6").PasteSpecial xlValue
'　　Application.CutCopyMode = False
　　
　　With .Rows(rw1 + 1)
'　　　Range("A7:O15").Sort Key1:=Range("D7"), Order1:=xlAscending,
　　　.Resize(rw2 - rw1, 15) _
　　　　.Sort Key1:=.Resize(, 1).Offset(, 3), Order1:=xlAscending, _
　　　　　Header:=xlGuess, OrderCustom:=1, Orientation:=xlTopToBottom, _
　　　　　　SortMethod:=xlPinYin
　　End With
　End With
End Sub

0 hits

▼

【46982】条件つき列の並べ替え　[46222]関連 さや 07/2/24(土) 16:20