Excel VBA質問箱 IV

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

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


37477 / 76732 ←次へ | 前へ→

【44420】Re:2項目の日付表示では
回答  yata  - 06/11/15(水) 21:34 -

引用なし
パスワード
   素人じゅうすけ さん こんばんわ
2項目の日付表示について
C列に縦方向に表示ではなく、同じ行の右方向に表示でしたら割と簡単です。

最初に提示した行挿入が無いコードに追加してください
Sub Test2()
Dim R As Long, r2 As Long '元データの行数と転記先の行番号
Dim 人名 As String
Dim Sum As Double
R = UsedRange.Rows.Count

人名 = InputBox("抽出する人")

For Each Rng In Range(Range("C2"), Cells(R, 3))
If Rng.Value = 人名 Then
    'G列から取り出して合計する
    Sum = Sum + Rng.Offset(0, 4).Value

End If
Next

With Sheets("Sheet4")
    r2 = .Range("A65536").End(xlUp).Offset(1, 0).Row
    .Cells(r2, 1) = 人名
    .Cells(r2, 2) = Sum
    For Each Rng In Range(Range("C2"), Cells(R, 3))    '●ここから
      If Rng.Value = 人名 Then
        日付 = Rng.Offset(0, -2)
        .Cells(r2, 1).End(xlToRight).Offset(0, 1) = 日付
      End If
    Next                        '●ここまでを追加
End With

'降順に並べ替え
With Sheets("Sheet4")
.Activate
'データが1件以上あったら並び替えをする
If .Range("A3") <> "" Then
.Range("A1").Select
Selection.Sort Key1:=.Range("B2"), Order1:=xlDescending
End If
End With
End Sub

これでも空白行を入れると
.Range("A1").Select
Selection.Sort Key1:=.Range("B2"), Order1:=xlDescending
では最初の空白行以降は並び替えの対象にならないので
.Range("A1").Select を全セルを対象にして .Cells.Select としなければなりません。
また、この場合は並び替えられたら空白行は全て取り除かれます。
ということで加工の対象となるデータは極力空白行を作ったりしない方がよいと思います。
必要なら全て作業が終わってから表を整えるのが良いと思います。
1 hits

【44202】別のSHEETへの答え記入 素人じゅうすけ 06/11/8(水) 20:58 質問
【44206】Re:別のSHEETへの答え記入 りん 06/11/9(木) 12:02 発言
【44208】Re:別のSHEETへの答え記入 素人じゅうすけ 06/11/9(木) 18:01 お礼
【44215】Re:勘違いかもしれませんが yata 06/11/9(木) 22:13 回答
【44251】Re:勘違いかもしれませんが 素人じゅうすけ 06/11/10(金) 19:11 質問
【44255】Re:勘違いかもしれませんが yata 06/11/10(金) 22:44 回答
【44266】Re:勘違いかもしれませんが 素人じゅうすけ 06/11/11(土) 14:11 質問
【44289】Re:取り敢えず1項目だけ yata 06/11/12(日) 8:42 回答
【44291】Re:取り敢えず1項目だけ 素人じゅうすけ 06/11/12(日) 9:36 回答
【44293】Re:取り敢えず1項目だけ 素人じゅうすけ 06/11/12(日) 10:30 質問
【44301】Re:1項目の説明と2項目 yata 06/11/12(日) 19:10 回答
【44313】Re:1項目の説明と2項目 素人じゅうすけ 06/11/13(月) 9:30 回答
【44383】Re:1項目の説明と2項目 素人じゅうすけ 06/11/14(火) 17:21 質問
【44389】Re:訂正と2項目の行挿入 yata 06/11/14(火) 19:51 回答
【44404】Re:訂正と2項目の行挿入 素人じゅうすけ 06/11/15(水) 9:37 質問
【44420】Re:2項目の日付表示では yata 06/11/15(水) 21:34 回答
【44486】Re:2項目の日付表示では 素人じゅうすけ 06/11/18(土) 14:53 お礼
【44542】Re:2項目の日付表示では 素人じゅうすけ 06/11/21(火) 9:43 質問
【44568】Re:2項目の日付表示では yata 06/11/21(火) 22:46 回答
【44590】Re:2項目の日付表示では 素人じゅうすけ 06/11/22(水) 17:40 お礼

37477 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free