Excel VBA質問箱 IV

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

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


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

1759 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

▼

【72108】ステートメントを教えてください 本山中 12/5/30(水) 10:29

【72109】Re:ステートメントを教えてください UO3 12/5/30(水) 11:14

【72110】Re:ステートメントを教えてください UO3 12/5/30(水) 11:21

【72111】Re:ステートメントを教えてください 本山中 12/5/30(水) 11:58

【72112】Re:ステートメントを教えてください UO3 12/5/30(水) 12:17

【72113】Re:ステートメントを教えてください 本山中 12/5/30(水) 13:53

【72116】Re:ステートメントを教えてください UO3 12/5/30(水) 20:09

【72119】Re:ステートメントを教えてください 本山中 12/5/31(木) 5:55

【72114】Re:ステートメントを教えてください ドカ 12/5/30(水) 17:29

【72115】Re:ステートメントを教えてください ドカ 12/5/30(水) 17:56


	【72108】ステートメントを教えてください

本山中 - 12/5/30(水) 10:29 -


	引用なし

	パスワード

1.毎日1回、新しい情報を最後尾の行から入力しています。
2.同じコード番号があれば、直近の日付のコード番号の下の行へ
　並び替えをさせます。　
3.最新の日付の利益ー直近の日付の利益＞0なら、最新の日付の
　行の文字を赤く染めます。
これらを下記のステートメントで処理しています。
これからがお願いです。
最新の日付の利益ー直近の日付の利益＜0なら
直近の日付のものを含めて、以前のコート番号の行を全て、
削除したい(同じコード番号のものだけです)。
コード番号はA列、利益はH列に入力されています。
例
1100(A列)……100(H列)
1200……………200
1200……………250
1200……………150
1300……………150
1300……………200
となった場合、
1100……………100
1200……………150
1300……………150
1300……………200
という具合にしたいのです。
宜しくお願いいたします。

Sub 削除する()
　 Dim lastgyou As Integer
　 Dim i As Integer
　 Dim j As Integer
　 Dim atai As Integer
　 Dim zr As Integer
　 lastgyou = Cells(Rows.Count, 1).End(xlUp).Row
　 For i = 2 To lastgyou - 1
　　 atai = Cells(i, 2).Value
　　　 For j = i + 1 To lastgyou
　　　　 If atai = Cells(j, 2).Value Then
　　　　　 If j <> i + 1 Then
　　　　　　 Rows(j).Cut
　　　　　　 Rows(i + 1).Insert Shift:=xlDown
　　　　　 End If
　　　　　　　zr = Cells(i + 1, 8).Value - Cells(i, 8).Value
　　　　　　　　If zr > 0 Then
　　　　　　　　　Rows(i + 1).Font.ColorIndex = 3
　　　　　　　　End If
　　　　　 i = i + 1
　　　　　End If
　　　 Next j
　 Next i
End Sub


	【72109】Re:ステートメントを教えてください

UO3 - 12/5/30(水) 11:14 -


	引用なし

	パスワード

▼本山中さん：

こんにちは

回答案を考える前にいくつか。

コードからは離れて、この種のデータシートであれば、日付列も用意しておいたほうが
運用上、何かとわかりやすいと思いますが、まぁ、これは、レイアウトも含めて、そちらの
要件なんでしょうから、それはさておき。

・並び替えは処理前に手作業で行っておかれるんですね？
・並び替えた結果、たとえば 1200 が 2行あったとします。
　考えられる状況としては

　１）以前に１行あり、今回、１行追加された。だから比較必要。
　２）以前から２行あっり、今回は追加されなかった。
　　昨日、この処理はなされていますね。

　まぁ、２）場合でも、最後の２行を処理してもいいのでしょうが、
　そういうことですね？

・直近の日付のものを含めて以前のものを削除　という意味ですけど
　最新のものを残し、その１行だけにするということですね？

あと、コード内で　Cells(i, 2).Value　B列の値を参照していますが
これは正しいのですか？


	【72110】Re:ステートメントを教えてください

UO3 - 12/5/30(水) 11:21 -


	引用なし

	パスワード

▼本山中さん：

追加で

アップされたコードは、本当に、現在の要件を正しく実現していますか？
こちらで、同じ番号で金額が 200 250 150 と　３行ずつ作って実行してみましたら
最初の番号では、３行のうち、真ん中の行が赤くなり、
以降の番号では３行のうち、最初の２行が赤くなりましたけど？


	【72111】Re:ステートメントを教えてください

本山中 - 12/5/30(水) 11:58 -


	引用なし

	パスワード

▼UO3 さん：
>▼本山中さん：
>
>追加で
>
>アップされたコードは、本当に、現在の要件を正しく実現していますか？
>こちらで、同じ番号で金額が 200 250 150 と　３行ずつ作って実行してみましたら
>最初の番号では、３行のうち、真ん中の行が赤くなり、
>以降の番号では３行のうち、最初の２行が赤くなりましたけど？

回答をありがとうございます。
実例を次にコピーしておきます。

5月14日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　　　　　10
5月15日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　　　　　11.55
5月16日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　　　　　12.07
5月14日　　　　3636　　　　三菱総合研究所　　　　　　　　　　　　　 25.21
5月15日　　　　3636　　　　三菱総合研究所　　　　　　　　　　　　 26.04
5月16日　　　　3636　　　　三菱総合研究所　　　　　　　　　　　　　　　　 25.51
5月14日　　　　3641　　　　パピレス　　　　　　　　　　　　　　　　　12.08
5月15日　　　　3641　　　　パピレス　　　　　　　　　　　　　　　　13.64
5月16日　　　　3641　　　　パピレス　　　　　　　　　　　　　　　　15.65
5月14日　　　　3644　　　　１ｓｔ　ＨＬＤＧ　　　　　　　　　　　　12.33
5月15日　　　　3644　　　　１ｓｔ　ＨＬＤＧ　　　　　　　　　　　　11.89
5月16日　　　　3644　　　　１ｓｔ　ＨＬＤＧ　　　　　　　　　　　　14.1

コーエーテクモＨＬＤＧの5月15日、5月16日
三菱総合研究所の5月15日
パピレスの5月15日、5月16日
１ｓｔ　ＨＬＤＧの5月16日
が、それぞれ赤くなっています。
尚、右端の数値が利益です。


	【72112】Re:ステートメントを教えてください

UO3 - 12/5/30(水) 12:17 -


	引用なし

	パスワード

▼本山中さん：

ということは番号はＡ列ではなく、Ｂ列ということだったんですね。
コード案です。まだ、レイアウトに誤解があるかもしれません。
誤解していたら指摘願います。

Sub Sample()
　　Dim f As Long, t As Long
　　Dim c As Range
　　Dim delRows As Range
　　Cells.Font.ColorIndex = xlAutomatic　'昨日の色塗りをいったん解除
　　f = 2　 '同じ番号の行の最初の行番号
　　'B2からB列データ最終行までのセルを抽出
　　For Each c In Range("B2", Range("B" & Rows.Count).End(xlUp))
　　　　t = c.Row　 '同じ番号の行の最後の行番号
　　　　If c.Value <> c.Offset(1).Value Then 'これが同じ番号の最後なら
　　　　　　If t > f Then　'同じ番号が2行以上あれば処理
　　　　　　
　　　　　　　　If Cells(t, "H").Value > Cells(t - 1, "H").Value Then
　　　　　　　　　　Rows(t).Font.Color = vbRed　'直近より最新の利益が大きければ最新の行の文字色を赤に
　　　　　　　　ElseIf Cells(t, "H").Value < Cells(t - 1, "H").Value Then
　　　　　　　　　　'直近より最新の利益が小さければ最新の行のみを残しあとは削除
　　　　　　　　　　If delRows Is Nothing Then
　　　　　　　　　　　　Set delRows = Rows(f & ":" & t - 1)
　　　　　　　　　　Else
　　　　　　　　　　　　Set delRows = Union(delRows, Rows(f & ":" & t - 1))
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　End If
　　　　　　f = t + 1
　　　　End If
　　　　
　　Next
　　
　　'削除すべき行があった場合はそれを一括削除
　　If Not delRows Is Nothing Then delRows.Delete
　　　　　　　　
End Sub


	【72113】Re:ステートメントを教えてください

本山中 - 12/5/30(水) 13:53 -


	引用なし

	パスワード

▼UO3 さん：
度々の回答をありがとうございます。
UO3 さんからのコードで、下記例を試してみました。
例(5月30日 3636　　　　三菱総合研究所 20　を追加してみました)
5月14日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　10
5月15日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　11.55
5月16日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　12.07
5月16日　　　　3636　　　　三菱総合研究所　　　　　　　　25.51
5月14日　　　　3641　　　　パピレス　　　　　　　　　　　　12.08
5月15日　　　　3641　　　　パピレス　　　　　　　　　　　　13.64
5月16日　　　　3641　　　　パピレス　　　　　　　　　　　　15.65
5月14日　　　　3644　　　　１ｓｔ　ＨＬＤＧ　　　　　　　　12.33
5月15日　　　　3644　　　　１ｓｔ　ＨＬＤＧ　　　　　　　　11.89
5月16日　　　　3644　　　　１ｓｔ　ＨＬＤＧ　　　　　　　　14.1
5月30日　　　　3636　　　　三菱総合研究所　　　　　　　　20

結果
5月16日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　12.07
5月16日　　　　3641　　　　パピレス　　　　　　　　　　　　15.65
5月16日　　　　3644　　　　１ｓｔ　ＨＬＤＧ　　　　　　　　14.1
だけが赤くなりました。

希望するのは
1.5月30日　　　　3636　　　　三菱総合研究所　　　　　　　　20　が　　

　5月14日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　10
　5月15日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　11.55
　5月16日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　12.07
　5月16日　　　　3636　　　　三菱総合研究所　　　　　　　　25.51
　5月30日　　　　3636　　　　三菱総合研究所　　　　　　　　20
　5月14日　　　　3641　　　　パピレス　　　　　　　　　　　　12.08

　となって、尚且つ
　5月14日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　10
　5月15日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　11.55
　5月16日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　12.07
　5月30日　　　　3636　　　　三菱総合研究所　　　　　　　　20
　5月14日　　　　3641　　　　パピレス　　　　　　　　　　　　12.08
　となることです。
2.更に最終結果は
　5月14日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　10
　5月15日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　11.55
　5月16日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　12.07
　5月30日　　　　3636　　　　三菱総合研究所　　　　　　　　20　　
　5月14日　　　　3641　　　　パピレス　　　　　　　　　　　　12.08
　5月15日　　　　3641　　　　パピレス　　　　　　　　　　　　13.64
　5月16日　　　　3641　　　　パピレス　　　　　　　　　　　　15.65
　5月15日　　　　3644　　　　１ｓｔ　ＨＬＤＧ　　　　　　　　11.89
　5月16日　　　　3644　　　　１ｓｔ　ＨＬＤＧ　　　　　　　　14.1
　となり、
　5月15日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　11.55
　5月16日　　　　3635　　　　コーエーテクモＨＬＤＧ　　　　12.07
　5月15日　　　　3641　　　　パピレス　　　　　　　　　　　　13.64
　5月16日　　　　3641　　　　パピレス　　　　　　　　　　　　15.65
　5月16日　　　　3644　　　　１ｓｔ　ＨＬＤＧ　　　　　　　　14.1
が、赤くなってほしいのです。

>ということは番号はＡ列ではなく、Ｂ列ということだったんですね。
>コード案です。まだ、レイアウトに誤解があるかもしれません。
>誤解していたら指摘願います。
>
>Sub Sample()
>　　Dim f As Long, t As Long
>　　Dim c As Range
>　　Dim delRows As Range
>　　Cells.Font.ColorIndex = xlAutomatic　'昨日の色塗りをいったん解除
>　　f = 2　 '同じ番号の行の最初の行番号
>　　'B2からB列データ最終行までのセルを抽出
>　　For Each c In Range("B2", Range("B" & Rows.Count).End(xlUp))
>　　　　t = c.Row　 '同じ番号の行の最後の行番号
>　　　　If c.Value <> c.Offset(1).Value Then 'これが同じ番号の最後なら
>　　　　　　If t > f Then　'同じ番号が2行以上あれば処理
>　　　　　　
>　　　　　　　　If Cells(t, "H").Value > Cells(t - 1, "H").Value Then
>　　　　　　　　　　Rows(t).Font.Color = vbRed　'直近より最新の利益が大きければ最新の行の文字色を赤に
>　　　　　　　　ElseIf Cells(t, "H").Value < Cells(t - 1, "H").Value Then
>　　　　　　　　　　'直近より最新の利益が小さければ最新の行のみを残しあとは削除
>　　　　　　　　　　If delRows Is Nothing Then
>　　　　　　　　　　　　Set delRows = Rows(f & ":" & t - 1)
>　　　　　　　　　　Else
>　　　　　　　　　　　　Set delRows = Union(delRows, Rows(f & ":" & t - 1))
>　　　　　　　　　　End If
>　　　　　　　　End If
>　　　　　　End If
>　　　　　　f = t + 1
>　　　　End If
>　　　　
>　　Next
>　　
>　　'削除すべき行があった場合はそれを一括削除
>　　If Not delRows Is Nothing Then delRows.Delete
>　　　　　　　　
>End Sub


	【72114】Re:ステートメントを教えてください

ドカ - 12/5/30(水) 17:29 -


	引用なし

	パスワード

▼本山中さん　こんにちは

他人のコードを読むのは大変なので、本山中さんのコードをいじってみました。

本山中さんのコードを少し直すと、赤色にすること以外は、ほとんど出来ているのですね。
ただ、ここから先が、ちょっと難しいですね。

Sub 削除する()
　 Dim lastgyou As Integer
　 Dim i As Integer
　 Dim j As Integer
　 Dim atai As Integer
　 Dim zr As Integer
　 lastgyou = Cells(Rows.Count, 1).End(xlUp).Row
　 For i = 2 To lastgyou - 1
　　 'atai = Cells(i, 2).Value
　　　 For j = i + 1 To lastgyou
　　　 Debug.Print j, i
　　　　 If Cells(i, 2).Value = Cells(j, 2).Value Then
　　　　
　　　　　 If Cells(i, 8).Value > Cells(j, 8).Value Then
　　　　　　 Rows(i).Delete
　　　　　　 'Rows(j).Cut
　　　　　　 'Rows(i + 1).Insert Shift:=xlDown
　　　　　 End If
　　　　　
　　　　　 zr = Cells(i + 1, 8).Value - Cells(i, 8).Value
　　　　　　　　If zr > 0 Then
　　　　　　　　　Rows(i + 1).Font.ColorIndex = 3
　　　　　　　　End If
　　　　　 i = i + 1
　　　　　End If
　　　
　　　 Next j
　 Next i
End Sub


	【72115】Re:ステートメントを教えてください

ドカ - 12/5/30(水) 17:56 -


	引用なし

	パスワード

本山中さん　こんにちは

なんか頭が混乱する条件ですね。
要は、行の頭から処理するのではなく、下から上に向かって処理すれば良いのではないかと思います。


	【72116】Re:ステートメントを教えてください

UO3 - 12/5/30(水) 20:09 -


	引用なし

	パスワード

▼本山中さん：

私のレスで念をおしていますが、処理前にB列で並び替えをしていたんではないのですか？
もし、並び替えがされていないのであれば、コードの先頭で並び替えを追加すればいいと思いますが。
（第１キーＢ列、第２キーＡ列）


	【72119】Re:ステートメントを教えてください

本山中 - 12/5/31(木) 5:55 -


	引用なし

	パスワード

▼UO3 さん：
ありがとうございます。
希望がかなえられました。
感謝いたします。

>▼本山中さん：
>
>私のレスで念をおしていますが、処理前にB列で並び替えをしていたんではないのですか？
>もし、並び替えがされていないのであれば、コードの先頭で並び替えを追加すればいいと思いますが。
>（第１キーＢ列、第２キーＡ列）


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

1759 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free