先日 コードは特定した数値でしたが,今回は 条件に合う数値なんですが お願いします。
A B C D
1 日付 コード 仕入れ金額 数量
2 10/2 0098 20 9
3 10/2 0180 21 9
4 10/3 0128 23 10
5 10/4 0089 24 9
6 10/9 0123 23 12
コード0099以下のデータ行を sheet2 へ
コード0100~0149のデータ行を sheet3 へ
コード0150以上のデータ行を sheet4 へ
値だけを貼り付けできないでしょうか?
よろしくお願いいたします。
No.1ベストアンサー
- 回答日時:
takara_kujio様、こんばんは。
Wendy02です。早速変更しましたので、お試しください。
>コード0099以下のデータ行を sheet2 へ
>コード0100~0149のデータ行を sheet3 へ
>コード0150以上のデータ行を sheet4 へ
前回、作っていて、そういうことになるのではないかなってフト思ったのが的中しました。(^^; ちょっと変更してみました。変更する場合は、MatchLike()というところで、直してください。
'-------------------------------------------------
Sub TurnOverCodeClassifying2()
Dim c As Range
Dim Ret As Integer
Dim i As Long
Dim j As Integer
With ActiveSheet
'タイトル行の貼り付け
For j = 2 To 4
Worksheets("Sheet" & j).Range("A1").CurrentRegion.ClearContents
.Rows(1).Copy Worksheets("Sheet" & j).Rows(1)
Next j
For Each c In .Range("B2", Range("B65536").End(xlUp))
Ret = MatchLike(c.Value)
If Ret > 0 Then
i = Ret + 1
c.Offset(, -1).Resize(, 4).Copy _
Worksheets("Sheet" & i).Range("A65536").End(xlUp).Offset(1)
Ret = 0
End If
Next c
End With
End Sub
'設定用
Private Function MatchLike(ByVal strArg As Long) As Integer
Dim i As Long
'ここで設定してください。
Select Case strArg
Case Is <= 99 '以下
i = 1
Case 100 To 149 '~の間
i = 2
Case Is >= 150 '以上
i = 3
End Select
MatchLike = i
End Function
'-------------------------------------------------
先日はどうもありがとうございました。
MatchLike っていうんですね~
VBEってすごいな~って思います。
この前の教えていただいたのを自分なりに直してやったも だめで お手上げでした。
(数を変えるだけ 笑)
これから 専門用語も私なりに覚えていかなくては・・・・
早速明日使ってみます。どうもありがとうございました~~
No.2
- 回答日時:
コード少なくするため、VLOOKUPのTRUE型を使ってみました。
Sheet3からSheet4,5,6へ振り分ける例でやってみました。
Sheet3のI1:J3に
01
1002
1503
を作りました。(もしかしたら100は99、150は149が正しいかも。十分テストできなかった)質問例ではテスト済み。
Sub test02()
Dim l(4) '3段階区分なので4にしている
d = Range("A20").End(xlUp).Row '最終データ行を第20行とする。
' MsgBox d
a = Array("sheet3", "sheet4", "Sheet5", "Sheet6") '3段階しかない場合の例、シート名
'----第1は元になるシート、その後は振り分ける段階に対応するシート名
'---書き出す各シートの第1行の1に初期化
For i = 1 To UBound(l)
l(i) = 1
Next i
'-----データ各行について振り分け
For i = 2 To d
n = Val(Worksheets(a(0)).Cells(i, "B"))
m = WorksheetFunction.VLookup(n, Range("i1:j3"), 2) 'I1:J3に段階表を作る(注)
'----元になるシートの行から、振り分け先のシートへセルの値をセット
Worksheets(a(m)).Cells(l(m), "A") = Worksheets(a(0)).Cells(i, "A")
Worksheets(a(m)).Cells(l(m), "B") = Worksheets(a(0)).Cells(i, "B")
Worksheets(a(m)).Cells(l(m), "C") = Worksheets(a(0)).Cells(i, "C") 'D列は省略
l(m) = l(m) + 1 '振り分けた先のシートの次に書き込む行を1段下へ
Next i
End Sub
各シートのA列は書式を日付にしておいてください。
<(もしかしたら100は99、150は149が正しいかも。十分テストできなかった)質問例ではテスト済み。
そうですそうです ^^;失礼しました。
早速明日会社で試して見ます。
ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・14歳の自分に衝撃の事実を告げてください
- ・架空の映画のネタバレレビュー
- ・「お昼の放送」の思い出
- ・昨日見た夢を教えて下さい
- ・ちょっと先の未来クイズ第4問
- ・【大喜利】【投稿~10/21(月)】買ったばかりの自転車を分解してひと言
- ・メモのコツを教えてください!
- ・CDの保有枚数を教えてください
- ・ホテルを選ぶとき、これだけは譲れない条件TOP3は?
- ・家・車以外で、人生で一番奮発した買い物
- ・人生最悪の忘れ物
- ・【コナン30周年】嘘でしょ!?と思った○○周年を教えて【ハルヒ20周年】
- ・ハマっている「お菓子」を教えて!
- ・最近、いつ泣きましたか?
- ・夏が終わったと感じる瞬間って、どんな時?
- ・10秒目をつむったら…
- ・人生のプチ美学を教えてください!!
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・都道府県穴埋めゲーム
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Access-VBAでExcelファイ...
-
Worksheets メソッドは失敗しま...
-
VBAマクロ実行時エラーの修正に...
-
「段」と「行」の違いがよくわ...
-
エクセルで特定の文字列が入っ...
-
Excel グラフのプロットからデ...
-
B列の最終行までA列をオート...
-
列方向、行方向の定義
-
Excelで、あるセルの値に応じて...
-
エクセル マクロ オートフィ...
-
Excel VBAでのWorksheet_Change...
-
VBA 空白行に転記する
-
エクセル マクロで数値が変っ...
-
マクロの「SaveAs」でエラーが...
-
VBA シートをコピーする際に Co...
-
エクセルVBAが途中で止まります
-
Excelの行数、列数を増やしたい...
-
エクセルで離れた列を選択して...
-
VLOOKUPの列番号の最大は?
-
Cellsのかっこの中はどっちが行...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
複数シートを一括で保護を掛け...
-
エクセルVBAでオブジェクトが必...
-
Access-VBAでExcelファイ...
-
コンボボックスへ降順に表示す...
-
エクセルのVBAについて教えてく...
-
エクセルを共有にすると、シー...
-
マクロ実行後、画面がちかちか...
-
マクロのコマンドボタン《Activ...
-
VBAでVlookup機能を使うときに...
-
エクセルのマクロ(大量データ...
-
エクセルVBAでフォームの無効化...
-
エクセルで品番を入れると、そ...
-
エクセルVBA 別シートの最終セ...
-
excelのvbaでのシート指定が時...
-
別のブックを開く時にシートを...
-
ExcelVBA その回のみ...
-
Excell VBA にて配列に定数を代...
-
他ブックへの書き込みについて
-
vbaアニメーションについて
-
エクセルからメールを送るマク...
おすすめ情報